purescript 0.6.9.5 → 0.7.0.0

raw patch · 283 files changed

+9781/−5734 lines, 283 filesdep +Globdep +HUnitdep +aesondep −file-embeddep ~basedep ~boxesdep ~directorynew-component:exe:psc-bundlenew-component:exe:psc-publishPVP ok

version bump matches the API change (PVP)

Dependencies added: Glob, HUnit, aeson, aeson-better-errors, ansi-wl-pprint, bower-json, bytestring, dlist, language-javascript, safe, semigroups, split, syb, text, transformers-compat, vector

Dependencies removed: file-embed

Dependency ranges changed: base, boxes, directory, mtl, pattern-arrows, transformers

API changes (from Hackage documentation)

- Language.PureScript: class (MonadReader (Options Make) m, MonadError String m) => MonadMake m

- Language.PureScript: compile :: (Functor m, Applicative m, MonadError String m, MonadReader (Options Compile) m) => [Module] -> [String] -> m (String, String, Environment)

- Language.PureScript: compile' :: (Functor m, Applicative m, MonadError String m, MonadReader (Options Compile) m) => Environment -> [Module] -> [String] -> m (String, String, Environment)

- Language.PureScript: getTimestamp :: MonadMake m => FilePath -> m (Maybe UTCTime)

- Language.PureScript: prelude :: String

- Language.PureScript: readTextFile :: MonadMake m => FilePath -> m String

- Language.PureScript: writeTextFile :: MonadMake m => FilePath -> String -> m ()

- Language.PureScript.AST.Binders: ConsBinder :: Binder -> Binder -> Binder

- Language.PureScript.AST.Declarations: exportedDctors :: Module -> ProperName -> [ProperName]

- Language.PureScript.AST.Declarations: exportedDeclarations :: Module -> [Declaration]

- Language.PureScript.AST.Declarations: isDctorExported :: ProperName -> Maybe [DeclarationRef] -> ProperName -> Bool

- Language.PureScript.AST.Declarations: isExported :: Maybe [DeclarationRef] -> Declaration -> Bool

- Language.PureScript.Constants: bitsNumber :: String

- Language.PureScript.Constants: boolLikeBoolean :: String

- Language.PureScript.Constants: numNumber :: String

- Language.PureScript.Constants: preludeUnsafe :: String

- Language.PureScript.DeadCodeElimination: eliminateDeadCode :: [ModuleName] -> [Module a] -> [Module a]

- Language.PureScript.Environment: DataConstructor :: NameKind

- Language.PureScript.Environment: Extern :: ForeignImportType -> NameKind

- Language.PureScript.Environment: ForeignImport :: ForeignImportType

- Language.PureScript.Environment: InlineJavascript :: ForeignImportType

- Language.PureScript.Environment: LocalVariable :: NameKind

- Language.PureScript.Environment: TypeClassAccessorImport :: NameKind

- Language.PureScript.Environment: TypeInstanceDictionaryValue :: NameKind

- Language.PureScript.Environment: Value :: NameKind

- Language.PureScript.Environment: data ForeignImportType

- Language.PureScript.Environment: instance Data ForeignImportType

- Language.PureScript.Environment: instance Eq ForeignImportType

- Language.PureScript.Environment: instance Show ForeignImportType

- Language.PureScript.Environment: instance Typeable ForeignImportType

- Language.PureScript.Errors: interpretMultipleErrors :: MonadError String m => Bool -> Either MultipleErrors a -> m a

- Language.PureScript.Options: Compile :: Mode

- Language.PureScript.Options: CompileOptions :: String -> [String] -> [String] -> ModeOptions Compile

- Language.PureScript.Options: Make :: Mode

- Language.PureScript.Options: MakeOptions :: ModeOptions Make

- Language.PureScript.Options: browserNamespace :: ModeOptions Compile -> String

- Language.PureScript.Options: codeGenModules :: ModeOptions Compile -> [String]

- Language.PureScript.Options: data Mode

- Language.PureScript.Options: data ModeOptions mode

- Language.PureScript.Options: defaultCompileOptions :: Options Compile

- Language.PureScript.Options: defaultMakeOptions :: Options Make

- Language.PureScript.Options: entryPointModules :: ModeOptions Compile -> [String]

- Language.PureScript.Options: instance Show (ModeOptions mode)

- Language.PureScript.Options: instance Show (Options mode)

- Language.PureScript.Options: optionsAdditional :: Options mode -> ModeOptions mode

- Language.PureScript.Options: optionsNoPrelude :: Options mode -> Bool

- Language.PureScript.Types: PrettyPrintArray :: Type -> Type

+ Language.PureScript: MakeActions :: (ModuleName -> m (Either RebuildPolicy (Maybe UTCTime))) -> (ModuleName -> m (Maybe UTCTime)) -> (ModuleName -> m (FilePath, String)) -> (Module Ann -> Environment -> SupplyVar -> Externs -> m ()) -> (String -> m ()) -> MakeActions m

+ Language.PureScript: codegen :: MakeActions m -> Module Ann -> Environment -> SupplyVar -> Externs -> m ()

+ Language.PureScript: data MakeActions m

+ Language.PureScript: getInputTimestamp :: MakeActions m -> ModuleName -> m (Either RebuildPolicy (Maybe UTCTime))

+ Language.PureScript: getOutputTimestamp :: MakeActions m -> ModuleName -> m (Maybe UTCTime)

+ Language.PureScript: readExterns :: MakeActions m -> ModuleName -> m (FilePath, String)

+ Language.PureScript: type Externs = String

+ Language.PureScript: type SupplyVar = Integer

+ Language.PureScript.AST.Binders: CharBinder :: Char -> Binder

+ Language.PureScript.AST.Declarations: CharLiteral :: Char -> Expr

+ Language.PureScript.AST.Declarations: ModuleRef :: ModuleName -> DeclarationRef

+ Language.PureScript.AST.Exported: exportedDeclarations :: Module -> [Declaration]

+ Language.PureScript.AST.Exported: isExported :: Maybe [DeclarationRef] -> Declaration -> Bool

+ Language.PureScript.AST.Operators: instance Eq Associativity

+ Language.PureScript.AST.Operators: instance Eq Fixity

+ Language.PureScript.AST.Operators: instance Ord Associativity

+ Language.PureScript.AST.Operators: instance Ord Fixity

+ Language.PureScript.AST.Operators: instance ToJSON Associativity

+ Language.PureScript.AST.Operators: instance ToJSON Fixity

+ Language.PureScript.AST.SourcePos: displaySourcePos :: SourcePos -> String

+ Language.PureScript.AST.SourcePos: displaySourceSpan :: SourceSpan -> String

+ Language.PureScript.AST.SourcePos: instance Ord SourcePos

+ Language.PureScript.AST.SourcePos: instance Ord SourceSpan

+ Language.PureScript.AST.SourcePos: instance ToJSON SourcePos

+ Language.PureScript.AST.SourcePos: instance ToJSON SourceSpan

+ Language.PureScript.CodeGen.JS: mainCall :: ModuleName -> String -> JS

+ Language.PureScript.CodeGen.JS.AST: everywhereOnJSTopDownM :: (Applicative m, Monad m) => (JS -> m JS) -> JS -> m JS

+ Language.PureScript.CodeGen.JS.Optimizer.Inliner: inlineArrComposition :: (Applicative m, MonadSupply m) => JS -> m JS

+ Language.PureScript.Constants: (<<<) :: String

+ Language.PureScript.Constants: bind :: String

+ Language.PureScript.Constants: bottom :: String

+ Language.PureScript.Constants: boundedBoolean :: String

+ Language.PureScript.Constants: complementedLatticeBoolean :: String

+ Language.PureScript.Constants: dataArrayUnsafe :: String

+ Language.PureScript.Constants: dataInt :: String

+ Language.PureScript.Constants: dataIntBits :: String

+ Language.PureScript.Constants: eqInt :: String

+ Language.PureScript.Constants: inf :: String

+ Language.PureScript.Constants: latticeBoolean :: String

+ Language.PureScript.Constants: mod :: String

+ Language.PureScript.Constants: moduloSemiringInt :: String

+ Language.PureScript.Constants: ordInt :: String

+ Language.PureScript.Constants: ringInt :: String

+ Language.PureScript.Constants: semiringInt :: String

+ Language.PureScript.Constants: sup :: String

+ Language.PureScript.Constants: top :: String

+ Language.PureScript.CoreFn.Literals: CharLiteral :: Char -> Literal a

+ Language.PureScript.CoreFn.Meta: IsForeign :: Meta

+ Language.PureScript.Docs.AsMarkdown: instance Eq First

+ Language.PureScript.Docs.AsMarkdown: instance Ord First

+ Language.PureScript.Docs.AsMarkdown: instance Show First

+ Language.PureScript.Docs.AsMarkdown: renderModulesAsMarkdown :: [Module] -> String

+ Language.PureScript.Docs.Convert: collectBookmarks :: InPackage Module -> [Bookmark]

+ Language.PureScript.Docs.Convert: convertModule :: Module -> Module

+ Language.PureScript.Docs.ParseAndDesugar: DesugarError :: MultipleErrors -> ParseDesugarError

+ Language.PureScript.Docs.ParseAndDesugar: ParseError :: MultipleErrors -> ParseDesugarError

+ Language.PureScript.Docs.ParseAndDesugar: SortModulesError :: MultipleErrors -> ParseDesugarError

+ Language.PureScript.Docs.ParseAndDesugar: data ParseDesugarError

+ Language.PureScript.Docs.ParseAndDesugar: instance Show ParseDesugarError

+ Language.PureScript.Docs.ParseAndDesugar: parseAndDesugar :: [FilePath] -> [(PackageName, FilePath)] -> ([Bookmark] -> [Module] -> IO a) -> IO (Either ParseDesugarError a)

+ Language.PureScript.Docs.Render: notQualified :: String -> Qualified ProperName

+ Language.PureScript.Docs.Render: renderChildDeclaration :: ChildDeclaration -> RenderedCode

+ Language.PureScript.Docs.Render: renderChildDeclarationWithOptions :: RenderTypeOptions -> ChildDeclaration -> RenderedCode

+ Language.PureScript.Docs.Render: renderConstraint :: (Qualified ProperName, [Type]) -> RenderedCode

+ Language.PureScript.Docs.Render: renderConstraintWithOptions :: RenderTypeOptions -> (Qualified ProperName, [Type]) -> RenderedCode

+ Language.PureScript.Docs.Render: renderConstraints :: [Constraint] -> Maybe RenderedCode

+ Language.PureScript.Docs.Render: renderConstraintsWithOptions :: RenderTypeOptions -> [Constraint] -> Maybe RenderedCode

+ Language.PureScript.Docs.Render: renderDeclaration :: Declaration -> RenderedCode

+ Language.PureScript.Docs.Render: renderDeclarationWithOptions :: RenderTypeOptions -> Declaration -> RenderedCode

+ Language.PureScript.Docs.Render: toTypeVar :: (String, Maybe Kind) -> Type

+ Language.PureScript.Docs.Render: typeApp :: String -> [(String, Maybe Kind)] -> Type

+ Language.PureScript.Docs.RenderedCode.Render: RenderTypeOptions :: Bool -> RenderTypeOptions

+ Language.PureScript.Docs.RenderedCode.Render: data RenderTypeOptions

+ Language.PureScript.Docs.RenderedCode.Render: defaultRenderTypeOptions :: RenderTypeOptions

+ Language.PureScript.Docs.RenderedCode.Render: prettyPrintObjects :: RenderTypeOptions -> Bool

+ Language.PureScript.Docs.RenderedCode.Render: renderKind :: Kind -> RenderedCode

+ Language.PureScript.Docs.RenderedCode.Render: renderRow :: Type -> RenderedCode

+ Language.PureScript.Docs.RenderedCode.Render: renderType :: Type -> RenderedCode

+ Language.PureScript.Docs.RenderedCode.Render: renderTypeAtom :: Type -> RenderedCode

+ Language.PureScript.Docs.RenderedCode.Render: renderTypeWithOptions :: RenderTypeOptions -> Type -> RenderedCode

+ Language.PureScript.Docs.RenderedCode.Types: Ctor :: String -> ContainingModule -> RenderedCodeElement

+ Language.PureScript.Docs.RenderedCode.Types: Ident :: String -> RenderedCodeElement

+ Language.PureScript.Docs.RenderedCode.Types: Keyword :: String -> RenderedCodeElement

+ Language.PureScript.Docs.RenderedCode.Types: Kind :: String -> RenderedCodeElement

+ Language.PureScript.Docs.RenderedCode.Types: OtherModule :: ModuleName -> ContainingModule

+ Language.PureScript.Docs.RenderedCode.Types: Space :: RenderedCodeElement

+ Language.PureScript.Docs.RenderedCode.Types: Syntax :: String -> RenderedCodeElement

+ Language.PureScript.Docs.RenderedCode.Types: ThisModule :: ContainingModule

+ Language.PureScript.Docs.RenderedCode.Types: asContainingModule :: Parse e ContainingModule

+ Language.PureScript.Docs.RenderedCode.Types: asRenderedCode :: Parse String RenderedCode

+ Language.PureScript.Docs.RenderedCode.Types: asRenderedCodeElement :: Parse String RenderedCodeElement

+ Language.PureScript.Docs.RenderedCode.Types: containingModuleToMaybe :: ContainingModule -> Maybe ModuleName

+ Language.PureScript.Docs.RenderedCode.Types: ctor :: String -> ContainingModule -> RenderedCode

+ Language.PureScript.Docs.RenderedCode.Types: data ContainingModule

+ Language.PureScript.Docs.RenderedCode.Types: data RenderedCode

+ Language.PureScript.Docs.RenderedCode.Types: data RenderedCodeElement

+ Language.PureScript.Docs.RenderedCode.Types: fromContainingModule :: ModuleName -> ContainingModule -> ModuleName

+ Language.PureScript.Docs.RenderedCode.Types: ident :: String -> RenderedCode

+ Language.PureScript.Docs.RenderedCode.Types: instance Eq ContainingModule

+ Language.PureScript.Docs.RenderedCode.Types: instance Eq RenderedCode

+ Language.PureScript.Docs.RenderedCode.Types: instance Eq RenderedCodeElement

+ Language.PureScript.Docs.RenderedCode.Types: instance Monoid RenderedCode

+ Language.PureScript.Docs.RenderedCode.Types: instance Ord ContainingModule

+ Language.PureScript.Docs.RenderedCode.Types: instance Ord RenderedCode

+ Language.PureScript.Docs.RenderedCode.Types: instance Ord RenderedCodeElement

+ Language.PureScript.Docs.RenderedCode.Types: instance Show ContainingModule

+ Language.PureScript.Docs.RenderedCode.Types: instance Show RenderedCode

+ Language.PureScript.Docs.RenderedCode.Types: instance Show RenderedCodeElement

+ Language.PureScript.Docs.RenderedCode.Types: instance ToJSON ContainingModule

+ Language.PureScript.Docs.RenderedCode.Types: instance ToJSON RenderedCode

+ Language.PureScript.Docs.RenderedCode.Types: instance ToJSON RenderedCodeElement

+ Language.PureScript.Docs.RenderedCode.Types: keyword :: String -> RenderedCode

+ Language.PureScript.Docs.RenderedCode.Types: keywordClass :: RenderedCode

+ Language.PureScript.Docs.RenderedCode.Types: keywordData :: RenderedCode

+ Language.PureScript.Docs.RenderedCode.Types: keywordForall :: RenderedCode

+ Language.PureScript.Docs.RenderedCode.Types: keywordInstance :: RenderedCode

+ Language.PureScript.Docs.RenderedCode.Types: keywordNewtype :: RenderedCode

+ Language.PureScript.Docs.RenderedCode.Types: keywordType :: RenderedCode

+ Language.PureScript.Docs.RenderedCode.Types: keywordWhere :: RenderedCode

+ Language.PureScript.Docs.RenderedCode.Types: kind :: String -> RenderedCode

+ Language.PureScript.Docs.RenderedCode.Types: maybeToContainingModule :: Maybe ModuleName -> ContainingModule

+ Language.PureScript.Docs.RenderedCode.Types: outputWith :: Monoid a => (RenderedCodeElement -> a) -> RenderedCode -> a

+ Language.PureScript.Docs.RenderedCode.Types: sp :: RenderedCode

+ Language.PureScript.Docs.RenderedCode.Types: syntax :: String -> RenderedCode

+ Language.PureScript.Docs.Types: ChildDataConstructor :: [Type] -> ChildDeclarationInfo

+ Language.PureScript.Docs.Types: ChildDeclaration :: String -> Maybe String -> Maybe SourceSpan -> ChildDeclarationInfo -> ChildDeclaration

+ Language.PureScript.Docs.Types: ChildInstance :: [Constraint] -> Type -> ChildDeclarationInfo

+ Language.PureScript.Docs.Types: ChildTypeClassMember :: Type -> ChildDeclarationInfo

+ Language.PureScript.Docs.Types: DataDeclaration :: DataDeclType -> [(String, Maybe Kind)] -> DeclarationInfo

+ Language.PureScript.Docs.Types: Declaration :: String -> Maybe String -> Maybe SourceSpan -> [ChildDeclaration] -> Maybe Fixity -> DeclarationInfo -> Declaration

+ Language.PureScript.Docs.Types: ErrorInPackageMeta :: BowerError -> PackageError

+ Language.PureScript.Docs.Types: ExternDataDeclaration :: Kind -> DeclarationInfo

+ Language.PureScript.Docs.Types: FromDep :: PackageName -> a -> InPackage a

+ Language.PureScript.Docs.Types: GithubRepo :: String -> GithubRepo

+ Language.PureScript.Docs.Types: GithubUser :: String -> GithubUser

+ Language.PureScript.Docs.Types: InvalidChildDeclarationType :: String -> PackageError

+ Language.PureScript.Docs.Types: InvalidDataDeclType :: String -> PackageError

+ Language.PureScript.Docs.Types: InvalidDeclarationType :: String -> PackageError

+ Language.PureScript.Docs.Types: InvalidFixity :: PackageError

+ Language.PureScript.Docs.Types: InvalidKind :: String -> PackageError

+ Language.PureScript.Docs.Types: InvalidVersion :: PackageError

+ Language.PureScript.Docs.Types: Local :: a -> InPackage a

+ Language.PureScript.Docs.Types: Module :: String -> Maybe String -> [Declaration] -> Module

+ Language.PureScript.Docs.Types: NotYetKnown :: NotYetKnown

+ Language.PureScript.Docs.Types: Package :: PackageMeta -> Version -> String -> [Module] -> [Bookmark] -> [(PackageName, Version)] -> (GithubUser, GithubRepo) -> a -> Package a

+ Language.PureScript.Docs.Types: TypeClassDeclaration :: [(String, Maybe Kind)] -> [Constraint] -> DeclarationInfo

+ Language.PureScript.Docs.Types: TypeSynonymDeclaration :: [(String, Maybe Kind)] -> Type -> DeclarationInfo

+ Language.PureScript.Docs.Types: ValueDeclaration :: Type -> DeclarationInfo

+ Language.PureScript.Docs.Types: asAssociativity :: Parse PackageError Associativity

+ Language.PureScript.Docs.Types: asBookmark :: Parse BowerError Bookmark

+ Language.PureScript.Docs.Types: asBookmarks :: Parse BowerError [Bookmark]

+ Language.PureScript.Docs.Types: asChildDeclaration :: Parse PackageError ChildDeclaration

+ Language.PureScript.Docs.Types: asChildDeclarationInfo :: Parse PackageError ChildDeclarationInfo

+ Language.PureScript.Docs.Types: asConstraint :: Parse PackageError Constraint

+ Language.PureScript.Docs.Types: asDataDeclType :: Parse PackageError DataDeclType

+ Language.PureScript.Docs.Types: asDeclaration :: Parse PackageError Declaration

+ Language.PureScript.Docs.Types: asDeclarationInfo :: Parse PackageError DeclarationInfo

+ Language.PureScript.Docs.Types: asFixity :: Parse PackageError Fixity

+ Language.PureScript.Docs.Types: asGithub :: Parse e (GithubUser, GithubRepo)

+ Language.PureScript.Docs.Types: asGithubUser :: Parse e GithubUser

+ Language.PureScript.Docs.Types: asKind :: Parse e Kind

+ Language.PureScript.Docs.Types: asModule :: Parse PackageError Module

+ Language.PureScript.Docs.Types: asNotYetKnown :: Parse e NotYetKnown

+ Language.PureScript.Docs.Types: asPackage :: (forall e. Parse e a) -> Parse PackageError (Package a)

+ Language.PureScript.Docs.Types: asQualifiedProperName :: Parse e (Qualified ProperName)

+ Language.PureScript.Docs.Types: asResolvedDependencies :: Parse PackageError [(PackageName, Version)]

+ Language.PureScript.Docs.Types: asSourcePos :: Parse e SourcePos

+ Language.PureScript.Docs.Types: asSourceSpan :: Parse e SourceSpan

+ Language.PureScript.Docs.Types: asType :: Parse e Type

+ Language.PureScript.Docs.Types: asTypeArguments :: Parse PackageError [(String, Maybe Kind)]

+ Language.PureScript.Docs.Types: asUploadedPackage :: Parse PackageError UploadedPackage

+ Language.PureScript.Docs.Types: asVerifiedPackage :: Parse PackageError VerifiedPackage

+ Language.PureScript.Docs.Types: asVersion :: Parse PackageError Version

+ Language.PureScript.Docs.Types: assocListToJSON :: (a -> Text) -> (b -> Text) -> [(a, b)] -> Value

+ Language.PureScript.Docs.Types: cdeclComments :: ChildDeclaration -> Maybe String

+ Language.PureScript.Docs.Types: cdeclInfo :: ChildDeclaration -> ChildDeclarationInfo

+ Language.PureScript.Docs.Types: cdeclSourceSpan :: ChildDeclaration -> Maybe SourceSpan

+ Language.PureScript.Docs.Types: cdeclTitle :: ChildDeclaration -> String

+ Language.PureScript.Docs.Types: childDeclInfoToString :: ChildDeclarationInfo -> String

+ Language.PureScript.Docs.Types: data ChildDeclaration

+ Language.PureScript.Docs.Types: data ChildDeclarationInfo

+ Language.PureScript.Docs.Types: data Declaration

+ Language.PureScript.Docs.Types: data DeclarationInfo

+ Language.PureScript.Docs.Types: data InPackage a

+ Language.PureScript.Docs.Types: data Module

+ Language.PureScript.Docs.Types: data NotYetKnown

+ Language.PureScript.Docs.Types: data Package a

+ Language.PureScript.Docs.Types: data PackageError

+ Language.PureScript.Docs.Types: declChildren :: Declaration -> [ChildDeclaration]

+ Language.PureScript.Docs.Types: declComments :: Declaration -> Maybe String

+ Language.PureScript.Docs.Types: declFixity :: Declaration -> Maybe Fixity

+ Language.PureScript.Docs.Types: declInfo :: Declaration -> DeclarationInfo

+ Language.PureScript.Docs.Types: declInfoToString :: DeclarationInfo -> String

+ Language.PureScript.Docs.Types: declSourceSpan :: Declaration -> Maybe SourceSpan

+ Language.PureScript.Docs.Types: declTitle :: Declaration -> String

+ Language.PureScript.Docs.Types: ignorePackage :: InPackage a -> a

+ Language.PureScript.Docs.Types: instance Eq ChildDeclaration

+ Language.PureScript.Docs.Types: instance Eq ChildDeclarationInfo

+ Language.PureScript.Docs.Types: instance Eq Declaration

+ Language.PureScript.Docs.Types: instance Eq DeclarationInfo

+ Language.PureScript.Docs.Types: instance Eq GithubRepo

+ Language.PureScript.Docs.Types: instance Eq GithubUser

+ Language.PureScript.Docs.Types: instance Eq Module

+ Language.PureScript.Docs.Types: instance Eq NotYetKnown

+ Language.PureScript.Docs.Types: instance Eq PackageError

+ Language.PureScript.Docs.Types: instance Eq a => Eq (InPackage a)

+ Language.PureScript.Docs.Types: instance Eq a => Eq (Package a)

+ Language.PureScript.Docs.Types: instance FromJSON GithubUser

+ Language.PureScript.Docs.Types: instance FromJSON NotYetKnown

+ Language.PureScript.Docs.Types: instance FromJSON a => FromJSON (Package a)

+ Language.PureScript.Docs.Types: instance Functor InPackage

+ Language.PureScript.Docs.Types: instance Ord ChildDeclaration

+ Language.PureScript.Docs.Types: instance Ord ChildDeclarationInfo

+ Language.PureScript.Docs.Types: instance Ord Declaration

+ Language.PureScript.Docs.Types: instance Ord DeclarationInfo

+ Language.PureScript.Docs.Types: instance Ord GithubRepo

+ Language.PureScript.Docs.Types: instance Ord GithubUser

+ Language.PureScript.Docs.Types: instance Ord Module

+ Language.PureScript.Docs.Types: instance Ord NotYetKnown

+ Language.PureScript.Docs.Types: instance Ord PackageError

+ Language.PureScript.Docs.Types: instance Ord a => Ord (InPackage a)

+ Language.PureScript.Docs.Types: instance Ord a => Ord (Package a)

+ Language.PureScript.Docs.Types: instance Show ChildDeclaration

+ Language.PureScript.Docs.Types: instance Show ChildDeclarationInfo

+ Language.PureScript.Docs.Types: instance Show Declaration

+ Language.PureScript.Docs.Types: instance Show DeclarationInfo

+ Language.PureScript.Docs.Types: instance Show GithubRepo

+ Language.PureScript.Docs.Types: instance Show GithubUser

+ Language.PureScript.Docs.Types: instance Show Module

+ Language.PureScript.Docs.Types: instance Show NotYetKnown

+ Language.PureScript.Docs.Types: instance Show PackageError

+ Language.PureScript.Docs.Types: instance Show a => Show (InPackage a)

+ Language.PureScript.Docs.Types: instance Show a => Show (Package a)

+ Language.PureScript.Docs.Types: instance ToJSON ChildDeclaration

+ Language.PureScript.Docs.Types: instance ToJSON ChildDeclarationInfo

+ Language.PureScript.Docs.Types: instance ToJSON Declaration

+ Language.PureScript.Docs.Types: instance ToJSON DeclarationInfo

+ Language.PureScript.Docs.Types: instance ToJSON GithubRepo

+ Language.PureScript.Docs.Types: instance ToJSON GithubUser

+ Language.PureScript.Docs.Types: instance ToJSON Module

+ Language.PureScript.Docs.Types: instance ToJSON NotYetKnown

+ Language.PureScript.Docs.Types: instance ToJSON a => ToJSON (InPackage a)

+ Language.PureScript.Docs.Types: instance ToJSON a => ToJSON (Package a)

+ Language.PureScript.Docs.Types: modComments :: Module -> Maybe String

+ Language.PureScript.Docs.Types: modDeclarations :: Module -> [Declaration]

+ Language.PureScript.Docs.Types: modName :: Module -> String

+ Language.PureScript.Docs.Types: newtype GithubRepo

+ Language.PureScript.Docs.Types: newtype GithubUser

+ Language.PureScript.Docs.Types: packageName :: Package a -> PackageName

+ Language.PureScript.Docs.Types: parseAssociativity :: String -> Maybe Associativity

+ Language.PureScript.Docs.Types: parseUploadedPackage :: ByteString -> Either (ParseError PackageError) UploadedPackage

+ Language.PureScript.Docs.Types: parseVerifiedPackage :: ByteString -> Either (ParseError PackageError) VerifiedPackage

+ Language.PureScript.Docs.Types: parseVersion' :: String -> Maybe Version

+ Language.PureScript.Docs.Types: pkgBookmarks :: Package a -> [Bookmark]

+ Language.PureScript.Docs.Types: pkgGithub :: Package a -> (GithubUser, GithubRepo)

+ Language.PureScript.Docs.Types: pkgMeta :: Package a -> PackageMeta

+ Language.PureScript.Docs.Types: pkgModules :: Package a -> [Module]

+ Language.PureScript.Docs.Types: pkgResolvedDependencies :: Package a -> [(PackageName, Version)]

+ Language.PureScript.Docs.Types: pkgUploader :: Package a -> a

+ Language.PureScript.Docs.Types: pkgVersion :: Package a -> Version

+ Language.PureScript.Docs.Types: pkgVersionTag :: Package a -> String

+ Language.PureScript.Docs.Types: runGithubRepo :: GithubRepo -> String

+ Language.PureScript.Docs.Types: runGithubUser :: GithubUser -> String

+ Language.PureScript.Docs.Types: takeLocal :: InPackage a -> Maybe a

+ Language.PureScript.Docs.Types: takeLocals :: [InPackage a] -> [a]

+ Language.PureScript.Docs.Types: type Bookmark = InPackage (ModuleName, String)

+ Language.PureScript.Docs.Types: type UploadedPackage = Package NotYetKnown

+ Language.PureScript.Docs.Types: type VerifiedPackage = Package GithubUser

+ Language.PureScript.Docs.Types: verifyPackage :: GithubUser -> UploadedPackage -> VerifiedPackage

+ Language.PureScript.Docs.Utils.MonoidExtras: mintersperse :: Monoid m => m -> [m] -> m

+ Language.PureScript.Environment: External :: NameKind

+ Language.PureScript.Environment: Private :: NameKind

+ Language.PureScript.Environment: Public :: NameKind

+ Language.PureScript.Environment: instance FromJSON DataDeclType

+ Language.PureScript.Environment: instance ToJSON DataDeclType

+ Language.PureScript.Environment: isObject :: Type -> Bool

+ Language.PureScript.Environment: lookupValue :: Environment -> Qualified Ident -> Maybe (Type, NameKind, NameVisibility)

+ Language.PureScript.Environment: tyChar :: Type

+ Language.PureScript.Environment: tyInt :: Type

+ Language.PureScript.Errors: CannotGetFileInfo :: FilePath -> SimpleErrorMessage

+ Language.PureScript.Errors: CannotReadFile :: FilePath -> SimpleErrorMessage

+ Language.PureScript.Errors: CannotWriteFile :: FilePath -> SimpleErrorMessage

+ Language.PureScript.Errors: ClassOperator :: ProperName -> Ident -> SimpleErrorMessage

+ Language.PureScript.Errors: CycleInModules :: [ModuleName] -> SimpleErrorMessage

+ Language.PureScript.Errors: ErrorParsingExterns :: ParseError -> SimpleErrorMessage

+ Language.PureScript.Errors: ErrorParsingFFIModule :: FilePath -> SimpleErrorMessage

+ Language.PureScript.Errors: ErrorParsingModule :: ParseError -> SimpleErrorMessage

+ Language.PureScript.Errors: ExtraneousClassMember :: Ident -> SimpleErrorMessage

+ Language.PureScript.Errors: InvalidExternsFile :: FilePath -> SimpleErrorMessage

+ Language.PureScript.Errors: MissingFFIModule :: ModuleName -> SimpleErrorMessage

+ Language.PureScript.Errors: MultipleFFIModules :: ModuleName -> [FilePath] -> SimpleErrorMessage

+ Language.PureScript.Errors: ShadowedName :: Ident -> SimpleErrorMessage

+ Language.PureScript.Errors: SimpleErrorWrapper :: SimpleErrorMessage -> ErrorMessage

+ Language.PureScript.Errors: SkolemLabel :: String -> LabelType

+ Language.PureScript.Errors: TypeLabel :: LabelType

+ Language.PureScript.Errors: UnnecessaryFFIModule :: ModuleName -> FilePath -> SimpleErrorMessage

+ Language.PureScript.Errors: WildcardInferredType :: Type -> SimpleErrorMessage

+ Language.PureScript.Errors: data LabelType

+ Language.PureScript.Errors: data SimpleErrorMessage

+ Language.PureScript.Errors: instance Eq LabelType

+ Language.PureScript.Errors: instance Ord LabelType

+ Language.PureScript.Errors: instance Show LabelType

+ Language.PureScript.Errors: instance Show SimpleErrorMessage

+ Language.PureScript.Errors: interpretMultipleErrorsAndWarnings :: (MonadError MultipleErrors m, MonadWriter MultipleErrors m) => (Either MultipleErrors a, MultipleErrors) -> m a

+ Language.PureScript.Errors: nonEmpty :: MultipleErrors -> Bool

+ Language.PureScript.Errors: onTypesInErrorMessageM :: Applicative m => (Type -> m Type) -> ErrorMessage -> m ErrorMessage

+ Language.PureScript.Errors: prettyPrintMultipleErrorsWith :: String -> String -> Bool -> MultipleErrors -> State UnknownMap String

+ Language.PureScript.Errors: prettyPrintMultipleWarnings :: Bool -> MultipleErrors -> String

+ Language.PureScript.Errors: replaceUnknowns :: Type -> State UnknownMap Type

+ Language.PureScript.Errors: singleError :: ErrorMessage -> MultipleErrors

+ Language.PureScript.Errors: type UnknownMap = Map (LabelType, Unknown) Unknown

+ Language.PureScript.Errors: unwrapErrorMessage :: ErrorMessage -> SimpleErrorMessage

+ Language.PureScript.Kinds: everywhereOnKindsM :: (Functor m, Applicative m, Monad m) => (Kind -> m Kind) -> Kind -> m Kind

+ Language.PureScript.Kinds: instance FromJSON Kind

+ Language.PureScript.Kinds: instance Ord Kind

+ Language.PureScript.Kinds: instance ToJSON Kind

+ Language.PureScript.Linter: lint :: (Applicative m, MonadWriter MultipleErrors m) => Module -> m ()

+ Language.PureScript.Names: instance a ~ ProperName => FromJSON (Qualified a)

+ Language.PureScript.Names: instance a ~ ProperName => ToJSON (Qualified a)

+ Language.PureScript.Options: defaultOptions :: Options

+ Language.PureScript.Options: instance Show Options

+ Language.PureScript.Options: optionsRequirePath :: Options -> Maybe FilePath

+ Language.PureScript.Parser.Common: featureWasRemoved :: String -> TokenParser a

+ Language.PureScript.Parser.JS: parseForeignModulesFromFiles :: (Functor m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) => [(FilePath, ForeignJS)] -> m (Map ModuleName (FilePath, ForeignJS))

+ Language.PureScript.Parser.JS: type ForeignJS = String

+ Language.PureScript.Parser.Lexer: charLiteral :: TokenParser Char

+ Language.PureScript.TypeChecker.Entailment: instance Eq Work

+ Language.PureScript.TypeChecker.Entailment: instance Num Work

+ Language.PureScript.TypeChecker.Entailment: instance Ord Work

+ Language.PureScript.TypeChecker.Entailment: instance Show Work

+ Language.PureScript.TypeChecker.Monad: instance MonadWriter MultipleErrors Check

+ Language.PureScript.TypeChecker.Monad: liftUnifyWarnings :: Partial t => (Substitution t -> ErrorMessage -> ErrorMessage) -> UnifyT t Check a -> Check (a, Substitution t)

+ Language.PureScript.TypeChecker.Monad: lookupTypeClassDictionaries :: (Functor m, MonadState CheckState m) => Maybe ModuleName -> m (Map (Qualified ProperName) (Map (Qualified Ident) TypeClassDictionaryInScope))

+ Language.PureScript.TypeChecker.Monad: preservingNames :: (Functor m, MonadState CheckState m) => m a -> m a

+ Language.PureScript.TypeChecker.Monad: withBindingGroupVisible :: (Functor m, MonadState CheckState m) => m a -> m a

+ Language.PureScript.Types: instance FromJSON SkolemScope

+ Language.PureScript.Types: instance FromJSON Type

+ Language.PureScript.Types: instance Ord Type

+ Language.PureScript.Types: instance ToJSON SkolemScope

+ Language.PureScript.Types: instance ToJSON Type

- Language.PureScript: make :: (Functor m, Applicative m, Monad m, MonadMake m) => FilePath -> [(Either RebuildPolicy FilePath, Module)] -> [String] -> m Environment

+ Language.PureScript: make :: (Functor m, Applicative m, Monad m, MonadReader Options m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) => MakeActions m -> [(Either RebuildPolicy FilePath, Module)] -> m Environment

- Language.PureScript: progress :: MonadMake m => String -> m ()

+ Language.PureScript: progress :: MakeActions m -> String -> m ()

- Language.PureScript.AST.Declarations: ExternDeclaration :: ForeignImportType -> Ident -> (Maybe JS) -> Type -> Declaration

+ Language.PureScript.AST.Declarations: ExternDeclaration :: Ident -> Type -> Declaration

- Language.PureScript.AST.Declarations: TypeClassDictionary :: Bool -> Constraint -> [TypeClassDictionaryInScope] -> Expr

+ Language.PureScript.AST.Declarations: TypeClassDictionary :: Bool -> Constraint -> (Map (Maybe ModuleName) (Map (Qualified ProperName) (Map (Qualified Ident) TypeClassDictionaryInScope))) -> Expr

- Language.PureScript.CodeGen.JS: moduleToJs :: (Applicative m, Monad m, MonadReader (Options mode) m, MonadSupply m) => Module Ann -> m [JS]

+ Language.PureScript.CodeGen.JS: moduleToJs :: (Applicative m, Monad m, MonadReader Options m, MonadSupply m) => Module Ann -> Maybe JS -> m [JS]

- Language.PureScript.CodeGen.JS.Optimizer: optimize :: (Monad m, MonadReader (Options mode) m) => JS -> m JS

+ Language.PureScript.CodeGen.JS.Optimizer: optimize :: (Monad m, MonadReader Options m, Applicative m, MonadSupply m) => JS -> m JS

- Language.PureScript.CodeGen.JS.Optimizer.MagicDo: magicDo :: Options mode -> JS -> JS

+ Language.PureScript.CodeGen.JS.Optimizer.MagicDo: magicDo :: Options -> JS -> JS

- Language.PureScript.CodeGen.JS.Optimizer.TCO: tco :: Options mode -> JS -> JS

+ Language.PureScript.CodeGen.JS.Optimizer.TCO: tco :: Options -> JS -> JS

- Language.PureScript.CoreFn.Module: type ForeignDecl = (Ident, Maybe JS, Type)

+ Language.PureScript.CoreFn.Module: type ForeignDecl = (Ident, Type)

- Language.PureScript.Environment: Environment :: Map (ModuleName, Ident) (Type, NameKind, NameVisibility) -> Map (Qualified ProperName) (Kind, TypeKind) -> Map (Qualified ProperName) (DataDeclType, ProperName, Type, [Ident]) -> Map (Qualified ProperName) ([(String, Maybe Kind)], Type) -> Map (Qualified Ident, Maybe ModuleName) TypeClassDictionaryInScope -> Map (Qualified ProperName) ([(String, Maybe Kind)], [(Ident, Type)], [Constraint]) -> Environment

+ Language.PureScript.Environment: Environment :: Map (ModuleName, Ident) (Type, NameKind, NameVisibility) -> Map (Qualified ProperName) (Kind, TypeKind) -> Map (Qualified ProperName) (DataDeclType, ProperName, Type, [Ident]) -> Map (Qualified ProperName) ([(String, Maybe Kind)], Type) -> Map (Maybe ModuleName) (Map (Qualified ProperName) (Map (Qualified Ident) TypeClassDictionaryInScope)) -> Map (Qualified ProperName) ([(String, Maybe Kind)], [(Ident, Type)], [Constraint]) -> Environment

- Language.PureScript.Environment: typeClassDictionaries :: Environment -> Map (Qualified Ident, Maybe ModuleName) TypeClassDictionaryInScope

+ Language.PureScript.Environment: typeClassDictionaries :: Environment -> Map (Maybe ModuleName) (Map (Qualified ProperName) (Map (Qualified Ident) TypeClassDictionaryInScope))

- Language.PureScript.Errors: ArgListLengthsDiffer :: Ident -> ErrorMessage

+ Language.PureScript.Errors: ArgListLengthsDiffer :: Ident -> SimpleErrorMessage

- Language.PureScript.Errors: CannotApplyFunction :: Type -> Expr -> ErrorMessage

+ Language.PureScript.Errors: CannotApplyFunction :: Type -> Expr -> SimpleErrorMessage

- Language.PureScript.Errors: CannotReorderOperators :: ErrorMessage

+ Language.PureScript.Errors: CannotReorderOperators :: SimpleErrorMessage

- Language.PureScript.Errors: ClassConflictsWithCtor :: ProperName -> ErrorMessage

+ Language.PureScript.Errors: ClassConflictsWithCtor :: ProperName -> SimpleErrorMessage

- Language.PureScript.Errors: ClassConflictsWithType :: ProperName -> ErrorMessage

+ Language.PureScript.Errors: ClassConflictsWithType :: ProperName -> SimpleErrorMessage

- Language.PureScript.Errors: ConflictingCtorDecls :: ProperName -> ErrorMessage

+ Language.PureScript.Errors: ConflictingCtorDecls :: ProperName -> SimpleErrorMessage

- Language.PureScript.Errors: ConflictingImport :: String -> ModuleName -> ErrorMessage

+ Language.PureScript.Errors: ConflictingImport :: String -> ModuleName -> SimpleErrorMessage

- Language.PureScript.Errors: ConflictingImports :: String -> ModuleName -> ModuleName -> ErrorMessage

+ Language.PureScript.Errors: ConflictingImports :: String -> ModuleName -> ModuleName -> SimpleErrorMessage

- Language.PureScript.Errors: ConflictingTypeDecls :: ProperName -> ErrorMessage

+ Language.PureScript.Errors: ConflictingTypeDecls :: ProperName -> SimpleErrorMessage

- Language.PureScript.Errors: ConstrainedTypeUnified :: Type -> Type -> ErrorMessage

+ Language.PureScript.Errors: ConstrainedTypeUnified :: Type -> Type -> SimpleErrorMessage

- Language.PureScript.Errors: CtorConflictsWithClass :: ProperName -> ErrorMessage

+ Language.PureScript.Errors: CtorConflictsWithClass :: ProperName -> SimpleErrorMessage

- Language.PureScript.Errors: CycleInDeclaration :: Ident -> ErrorMessage

+ Language.PureScript.Errors: CycleInDeclaration :: Ident -> SimpleErrorMessage

- Language.PureScript.Errors: CycleInTypeSynonym :: (Maybe ProperName) -> ErrorMessage

+ Language.PureScript.Errors: CycleInTypeSynonym :: (Maybe ProperName) -> SimpleErrorMessage

- Language.PureScript.Errors: DuplicateClassExport :: ProperName -> ErrorMessage

+ Language.PureScript.Errors: DuplicateClassExport :: ProperName -> SimpleErrorMessage

- Language.PureScript.Errors: DuplicateLabel :: String -> (Maybe Expr) -> ErrorMessage

+ Language.PureScript.Errors: DuplicateLabel :: String -> (Maybe Expr) -> SimpleErrorMessage

- Language.PureScript.Errors: DuplicateTypeArgument :: String -> ErrorMessage

+ Language.PureScript.Errors: DuplicateTypeArgument :: String -> SimpleErrorMessage

- Language.PureScript.Errors: DuplicateValueDeclaration :: Ident -> ErrorMessage

+ Language.PureScript.Errors: DuplicateValueDeclaration :: Ident -> SimpleErrorMessage

- Language.PureScript.Errors: DuplicateValueExport :: Ident -> ErrorMessage

+ Language.PureScript.Errors: DuplicateValueExport :: Ident -> SimpleErrorMessage

- Language.PureScript.Errors: EscapedSkolem :: (Maybe Expr) -> ErrorMessage

+ Language.PureScript.Errors: EscapedSkolem :: (Maybe Expr) -> SimpleErrorMessage

- Language.PureScript.Errors: ExpectedType :: Kind -> ErrorMessage

+ Language.PureScript.Errors: ExpectedType :: Kind -> SimpleErrorMessage

- Language.PureScript.Errors: ExprDoesNotHaveType :: Expr -> Type -> ErrorMessage

+ Language.PureScript.Errors: ExprDoesNotHaveType :: Expr -> Type -> SimpleErrorMessage

- Language.PureScript.Errors: IncorrectConstructorArity :: (Qualified ProperName) -> ErrorMessage

+ Language.PureScript.Errors: IncorrectConstructorArity :: (Qualified ProperName) -> SimpleErrorMessage

- Language.PureScript.Errors: InfiniteKind :: Kind -> ErrorMessage

+ Language.PureScript.Errors: InfiniteKind :: Kind -> SimpleErrorMessage

- Language.PureScript.Errors: InfiniteType :: Type -> ErrorMessage

+ Language.PureScript.Errors: InfiniteType :: Type -> SimpleErrorMessage

- Language.PureScript.Errors: InvalidDoBind :: ErrorMessage

+ Language.PureScript.Errors: InvalidDoBind :: SimpleErrorMessage

- Language.PureScript.Errors: InvalidDoLet :: ErrorMessage

+ Language.PureScript.Errors: InvalidDoLet :: SimpleErrorMessage

- Language.PureScript.Errors: InvalidInstanceHead :: Type -> ErrorMessage

+ Language.PureScript.Errors: InvalidInstanceHead :: Type -> SimpleErrorMessage

- Language.PureScript.Errors: InvalidNewtype :: ErrorMessage

+ Language.PureScript.Errors: InvalidNewtype :: SimpleErrorMessage

- Language.PureScript.Errors: KindsDoNotUnify :: Kind -> Kind -> ErrorMessage

+ Language.PureScript.Errors: KindsDoNotUnify :: Kind -> Kind -> SimpleErrorMessage

- Language.PureScript.Errors: MissingClassMember :: Ident -> ErrorMessage

+ Language.PureScript.Errors: MissingClassMember :: Ident -> SimpleErrorMessage

- Language.PureScript.Errors: MultipleFixities :: Ident -> ErrorMessage

+ Language.PureScript.Errors: MultipleFixities :: Ident -> SimpleErrorMessage

- Language.PureScript.Errors: NameIsUndefined :: Ident -> ErrorMessage

+ Language.PureScript.Errors: NameIsUndefined :: Ident -> SimpleErrorMessage

- Language.PureScript.Errors: NameNotInScope :: Ident -> ErrorMessage

+ Language.PureScript.Errors: NameNotInScope :: Ident -> SimpleErrorMessage

- Language.PureScript.Errors: NoInstanceFound :: (Qualified ProperName) -> [Type] -> ErrorMessage

+ Language.PureScript.Errors: NoInstanceFound :: (Qualified ProperName) -> [Type] -> SimpleErrorMessage

- Language.PureScript.Errors: OrphanFixityDeclaration :: String -> ErrorMessage

+ Language.PureScript.Errors: OrphanFixityDeclaration :: String -> SimpleErrorMessage

- Language.PureScript.Errors: OrphanTypeDeclaration :: Ident -> ErrorMessage

+ Language.PureScript.Errors: OrphanTypeDeclaration :: Ident -> SimpleErrorMessage

- Language.PureScript.Errors: OverlappingArgNames :: (Maybe Ident) -> ErrorMessage

+ Language.PureScript.Errors: OverlappingArgNames :: (Maybe Ident) -> SimpleErrorMessage

- Language.PureScript.Errors: OverlappingInstances :: (Qualified ProperName) -> [Type] -> [DictionaryValue] -> ErrorMessage

+ Language.PureScript.Errors: OverlappingInstances :: (Qualified ProperName) -> [Type] -> [DictionaryValue] -> SimpleErrorMessage

- Language.PureScript.Errors: OverlappingNamesInLet :: ErrorMessage

+ Language.PureScript.Errors: OverlappingNamesInLet :: SimpleErrorMessage

- Language.PureScript.Errors: PartiallyAppliedSynonym :: (Qualified ProperName) -> ErrorMessage

+ Language.PureScript.Errors: PartiallyAppliedSynonym :: (Qualified ProperName) -> SimpleErrorMessage

- Language.PureScript.Errors: PropertyIsMissing :: String -> Type -> ErrorMessage

+ Language.PureScript.Errors: PropertyIsMissing :: String -> Type -> SimpleErrorMessage

- Language.PureScript.Errors: RedefinedIdent :: Ident -> ErrorMessage

+ Language.PureScript.Errors: RedefinedIdent :: Ident -> SimpleErrorMessage

- Language.PureScript.Errors: RedefinedModule :: ModuleName -> ErrorMessage

+ Language.PureScript.Errors: RedefinedModule :: ModuleName -> SimpleErrorMessage

- Language.PureScript.Errors: SubsumptionCheckFailed :: ErrorMessage

+ Language.PureScript.Errors: SubsumptionCheckFailed :: SimpleErrorMessage

- Language.PureScript.Errors: TransitiveExportError :: DeclarationRef -> [DeclarationRef] -> ErrorMessage

+ Language.PureScript.Errors: TransitiveExportError :: DeclarationRef -> [DeclarationRef] -> SimpleErrorMessage

- Language.PureScript.Errors: TypeConflictsWithClass :: ProperName -> ErrorMessage

+ Language.PureScript.Errors: TypeConflictsWithClass :: ProperName -> SimpleErrorMessage

- Language.PureScript.Errors: TypeSynonymInstance :: ErrorMessage

+ Language.PureScript.Errors: TypeSynonymInstance :: SimpleErrorMessage

- Language.PureScript.Errors: TypesDoNotUnify :: Type -> Type -> ErrorMessage

+ Language.PureScript.Errors: TypesDoNotUnify :: Type -> Type -> SimpleErrorMessage

- Language.PureScript.Errors: UndefinedTypeVariable :: ProperName -> ErrorMessage

+ Language.PureScript.Errors: UndefinedTypeVariable :: ProperName -> SimpleErrorMessage

- Language.PureScript.Errors: UnknownDataConstructor :: (Qualified ProperName) -> (Maybe (Qualified ProperName)) -> ErrorMessage

+ Language.PureScript.Errors: UnknownDataConstructor :: (Qualified ProperName) -> (Maybe (Qualified ProperName)) -> SimpleErrorMessage

- Language.PureScript.Errors: UnknownModule :: ModuleName -> ErrorMessage

+ Language.PureScript.Errors: UnknownModule :: ModuleName -> SimpleErrorMessage

- Language.PureScript.Errors: UnknownType :: (Qualified ProperName) -> ErrorMessage

+ Language.PureScript.Errors: UnknownType :: (Qualified ProperName) -> SimpleErrorMessage

- Language.PureScript.Errors: UnknownTypeClass :: (Qualified ProperName) -> ErrorMessage

+ Language.PureScript.Errors: UnknownTypeClass :: (Qualified ProperName) -> SimpleErrorMessage

- Language.PureScript.Errors: UnknownTypeConstructor :: (Qualified ProperName) -> ErrorMessage

+ Language.PureScript.Errors: UnknownTypeConstructor :: (Qualified ProperName) -> SimpleErrorMessage

- Language.PureScript.Errors: UnknownValue :: (Qualified Ident) -> ErrorMessage

+ Language.PureScript.Errors: UnknownValue :: (Qualified Ident) -> SimpleErrorMessage

- Language.PureScript.Errors: UnspecifiedSkolemScope :: ErrorMessage

+ Language.PureScript.Errors: UnspecifiedSkolemScope :: SimpleErrorMessage

- Language.PureScript.Errors: errorMessage :: ErrorMessage -> MultipleErrors

+ Language.PureScript.Errors: errorMessage :: SimpleErrorMessage -> MultipleErrors

- Language.PureScript.Errors: prettyPrintSingleError :: Bool -> ErrorMessage -> Box

+ Language.PureScript.Errors: prettyPrintSingleError :: Bool -> ErrorMessage -> State UnknownMap Box

- Language.PureScript.ModuleDependencies: sortModules :: MonadError String m => [Module] -> m ([Module], ModuleGraph)

+ Language.PureScript.ModuleDependencies: sortModules :: MonadError MultipleErrors m => [Module] -> m ([Module], ModuleGraph)

- Language.PureScript.Options: Options :: Bool -> Bool -> Bool -> Maybe String -> Bool -> Bool -> Bool -> ModeOptions mode -> Options mode

+ Language.PureScript.Options: Options :: Bool -> Bool -> Maybe String -> Bool -> Bool -> Bool -> Maybe FilePath -> Options

- Language.PureScript.Options: data Options mode

+ Language.PureScript.Options: data Options

- Language.PureScript.Options: optionsMain :: Options mode -> Maybe String

+ Language.PureScript.Options: optionsMain :: Options -> Maybe String

- Language.PureScript.Options: optionsNoComments :: Options mode -> Bool

+ Language.PureScript.Options: optionsNoComments :: Options -> Bool

- Language.PureScript.Options: optionsNoMagicDo :: Options mode -> Bool

+ Language.PureScript.Options: optionsNoMagicDo :: Options -> Bool

- Language.PureScript.Options: optionsNoOptimizations :: Options mode -> Bool

+ Language.PureScript.Options: optionsNoOptimizations :: Options -> Bool

- Language.PureScript.Options: optionsNoTco :: Options mode -> Bool

+ Language.PureScript.Options: optionsNoTco :: Options -> Bool

- Language.PureScript.Options: optionsVerboseErrors :: Options mode -> Bool

+ Language.PureScript.Options: optionsVerboseErrors :: Options -> Bool

- Language.PureScript.Parser.Declarations: parseModulesFromFiles :: (k -> String) -> [(k, String)] -> Either ParseError [(k, Module)]

+ Language.PureScript.Parser.Declarations: parseModulesFromFiles :: (MonadError MultipleErrors m, Functor m) => (k -> String) -> [(k, String)] -> m [(k, Module)]

- Language.PureScript.TypeChecker.Entailment: entails :: Environment -> ModuleName -> [TypeClassDictionaryInScope] -> Constraint -> Bool -> Check Expr

+ Language.PureScript.TypeChecker.Entailment: entails :: Environment -> ModuleName -> Map (Maybe ModuleName) (Map (Qualified ProperName) (Map (Qualified Ident) TypeClassDictionaryInScope)) -> Constraint -> Bool -> Check Expr

- Language.PureScript.TypeChecker.Monad: Check :: StateT CheckState (Either MultipleErrors) a -> Check a

+ Language.PureScript.TypeChecker.Monad: Check :: StateT CheckState (ExceptT MultipleErrors (Writer MultipleErrors)) a -> Check a

- Language.PureScript.TypeChecker.Monad: getTypeClassDictionaries :: (Functor m, MonadState CheckState m) => m [TypeClassDictionaryInScope]

+ Language.PureScript.TypeChecker.Monad: getTypeClassDictionaries :: (Functor m, MonadState CheckState m) => m (Map (Maybe ModuleName) (Map (Qualified ProperName) (Map (Qualified Ident) TypeClassDictionaryInScope)))

- Language.PureScript.TypeChecker.Monad: makeBindingGroupVisible :: (Functor m, MonadState CheckState m) => m a -> m a

+ Language.PureScript.TypeChecker.Monad: makeBindingGroupVisible :: (Functor m, MonadState CheckState m) => m ()

- Language.PureScript.TypeChecker.Monad: runCheck :: (MonadReader (Options mode) m, MonadError String m) => Check a -> m (a, Environment)

+ Language.PureScript.TypeChecker.Monad: runCheck :: (MonadError MultipleErrors m, MonadWriter MultipleErrors m) => Check a -> m (a, Environment)

- Language.PureScript.TypeChecker.Monad: runCheck' :: (MonadReader (Options mode) m, MonadError String m) => Environment -> Check a -> m (a, Environment)

+ Language.PureScript.TypeChecker.Monad: runCheck' :: (MonadError MultipleErrors m, MonadWriter MultipleErrors m) => Environment -> Check a -> m (a, Environment)

- Language.PureScript.TypeChecker.Monad: unCheck :: Check a -> StateT CheckState (Either MultipleErrors) a

+ Language.PureScript.TypeChecker.Monad: unCheck :: Check a -> StateT CheckState (ExceptT MultipleErrors (Writer MultipleErrors)) a

- Language.PureScript.TypeChecker.Synonyms: saturateAllTypeSynonyms :: [(Qualified ProperName, Int)] -> Type -> Either ErrorMessage Type

+ Language.PureScript.TypeChecker.Synonyms: saturateAllTypeSynonyms :: Map (Qualified ProperName) Int -> Type -> Either ErrorMessage Type

Files

LICENSE +1867/−682
examples/failing/365.purs +13/−0
examples/failing/438.purs +11/−0
examples/failing/ArrayType.purs +1/−0
examples/failing/Arrays.purs +2/−2
examples/failing/CaseDoesNotMatchAllConstructorArgs.purs +14/−0
examples/failing/Do.purs +2/−0
examples/failing/DuplicateDeclarationsInLet.purs +2/−0
examples/failing/DuplicateProperties1.purs +4/−2
examples/failing/DuplicateProperties2.purs +4/−2
examples/failing/DuplicateTypeVars.purs +2/−0
examples/failing/Foldable.purs +9/−5
examples/failing/InstanceExport.purs +2/−0
examples/failing/KindError.purs +3/−1
examples/failing/LeadingZeros1.purs +5/−0
examples/failing/LeadingZeros2.purs +5/−0
examples/failing/Let.purs +2/−0
examples/failing/MPTCs.purs +2/−0
examples/failing/MissingClassExport.purs +4/−2
examples/failing/MissingClassMemberExport.purs +4/−2
examples/failing/MultipleErrors.purs +2/−0
examples/failing/MultipleErrors2.purs +2/−0
examples/failing/MutRec.purs +2/−0
examples/failing/MutRec2.purs +2/−0
examples/failing/NewtypeMultiArgs.purs +2/−0
examples/failing/NewtypeMultiCtor.purs +2/−0
examples/failing/NoOverlap.purs +2/−0
examples/failing/NullaryAbs.purs +3/−1
examples/failing/Object.purs +2/−0
examples/failing/OverlappingArguments.purs +2/−0
examples/failing/OverlappingBinders.purs +5/−1
examples/failing/OverlappingInstances.purs +2/−0
examples/failing/OverlappingInstances2.purs +2/−0
examples/failing/OverlappingVars.purs +2/−0
examples/failing/Rank2Types.purs +3/−3
examples/failing/Reserved.purs +2/−0
examples/failing/RowConstructors1.purs +8/−0
examples/failing/RowConstructors2.purs +8/−0
examples/failing/RowConstructors3.purs +8/−0
examples/failing/SkolemEscape.purs +4/−2
examples/failing/Superclasses1.purs +2/−0
examples/failing/Superclasses2.purs +2/−0
examples/failing/Superclasses3.purs +2/−0
examples/failing/Superclasses4.purs +2/−0
examples/failing/TopLevelCaseNoArgs.purs +6/−3
examples/failing/TypeClassInstances.purs +2/−0
examples/failing/TypeError.purs +2/−2
examples/failing/TypeSynonyms.purs +3/−1
examples/failing/TypeSynonyms2.purs +2/−0
examples/failing/TypeSynonyms3.purs +2/−0
examples/failing/TypeSynonyms4.purs +2/−0
examples/failing/TypeSynonyms5.purs +5/−0
examples/failing/TypeWildcards1.purs +2/−0
examples/failing/TypeWildcards2.purs +2/−0
examples/failing/TypeWildcards3.purs +2/−0
examples/failing/UnderscoreModuleName.purs +2/−0
examples/failing/UnifyInTypeInstanceLookup.purs +2/−0
examples/failing/UnknownType.purs +2/−0
examples/passing/652.purs +2/−0
examples/passing/810.purs +2/−0
examples/passing/ArrayType.purs +3/−1
examples/passing/Arrays.purs +0/−24
examples/passing/Auto.purs +9/−7
examples/passing/AutoPrelude.purs +4/−3
examples/passing/AutoPrelude2.purs +1/−0
examples/passing/BindersInFunctions.purs +5/−11
examples/passing/BindingGroups.purs +4/−2
examples/passing/BlockString.purs +3/−7
examples/passing/CaseInDo.purs +5/−6
examples/passing/CaseStatement.purs +2/−0
examples/passing/CheckFunction.purs +3/−1
examples/passing/CheckSynonymBug.purs +4/−11
examples/passing/CheckTypeClass.purs +11/−9
examples/passing/Church.purs +10/−10
examples/passing/Collatz.purs +5/−5
examples/passing/Comparisons.purs +5/−15
examples/passing/Conditional.purs +4/−4
examples/passing/Console.purs +3/−3
examples/passing/DataAndType.purs +2/−0
examples/passing/DeepArrayBinder.purs +9/−12
examples/passing/DeepCase.purs +4/−3
examples/passing/Do.purs +13/−13
examples/passing/Eff.purs +4/−4
examples/passing/EmptyDataDecls.purs +2/−17
examples/passing/EmptyRow.purs +2/−0
examples/passing/EmptyTypeClass.purs +2/−2
examples/passing/EqOrd.purs +3/−1
examples/passing/ExtendedInfixOperators.purs +5/−11
examples/passing/ExternData.purs +0/−13
examples/passing/ExternRaw.purs +0/−26
examples/passing/FFI.purs +0/−13
examples/passing/Fib.purs +3/−3
examples/passing/FinalTagless.purs +1/−1
examples/passing/ForeignInstance.purs +0/−20
examples/passing/FunctionScope.purs +9/−15
examples/passing/Functions.purs +7/−7
examples/passing/Functions2.purs +9/−15
examples/passing/Guards.purs +21/−21
examples/passing/HoistError.purs +5/−12
examples/passing/IfThenElseMaybe.purs +2/−0
examples/passing/ImplicitEmptyImport.purs +2/−0
examples/passing/ImportHiding.purs +1/−1
examples/passing/InferRecFunWithConstrainedArgument.purs +3/−3
examples/passing/InstanceBeforeClass.purs +3/−1
examples/passing/IntAndChar.purs +18/−0
examples/passing/JSReserved.purs +6/−6
examples/passing/KindedType.purs +5/−3
examples/passing/Let.purs +17/−28
examples/passing/Let2.purs +17/−0
examples/passing/LetInInstance.purs +2/−0
examples/passing/LiberalTypeSynonyms.purs +2/−0
examples/passing/Match.purs +5/−3
examples/passing/ModuleExport.purs +9/−0
examples/passing/ModuleExportDupes.purs +19/−0
examples/passing/ModuleExportExcluded.purs +14/−0
examples/passing/ModuleExportHiding.purs +11/−0
examples/passing/ModuleExportQualified.purs +9/−0
examples/passing/ModuleExportSelf.purs +14/−0
examples/passing/Monad.purs +21/−21
examples/passing/MonadState.purs +1/−1
examples/passing/MultiArgFunctions.purs +15/−14
examples/passing/MultipleConstructorArgs.purs +0/−21
examples/passing/MutRec.purs +10/−10
examples/passing/MutRec2.purs +2/−0
examples/passing/MutRec3.purs +2/−0
examples/passing/NamedPatterns.purs +6/−4
examples/passing/NegativeBinder.purs +3/−1
examples/passing/Nested.purs +5/−3
examples/passing/NestedTypeSynonyms.purs +6/−6
examples/passing/NestedWhere.purs +3/−1
examples/passing/Newtype.purs +3/−2
examples/passing/NewtypeEff.purs +2/−1
examples/passing/NewtypeWithRecordUpdate.purs +4/−3
examples/passing/ObjectGetter.purs +3/−1
examples/passing/ObjectSynonym.purs +3/−1
examples/passing/ObjectUpdate.purs +13/−11
examples/passing/ObjectUpdate2.purs +4/−1
examples/passing/ObjectUpdater.purs +10/−21
examples/passing/ObjectWildcards.purs +7/−18
examples/passing/Objects.purs +20/−20
examples/passing/OneConstructor.purs +2/−0
examples/passing/OperatorAssociativity.purs +17/−50
examples/passing/OperatorInlining.purs +47/−0
examples/passing/OperatorSections.purs +6/−16
examples/passing/Operators.purs +68/−71
examples/passing/OptimizerBug.purs +1/−1
examples/passing/PartialFunction.purs +5/−14
examples/passing/Patterns.purs +15/−21
examples/passing/Person.purs +6/−13
examples/passing/Rank2Data.purs +18/−18
examples/passing/Rank2Object.purs +2/−1
examples/passing/Rank2TypeSynonym.purs +2/−1
examples/passing/Rank2Types.purs +6/−6
examples/passing/RebindableSyntax.purs +39/−0
examples/passing/Recursion.purs +6/−6
examples/passing/ReservedWords.purs +9/−7
examples/passing/RowConstructors.purs +42/−0
examples/passing/RowPolyInstanceContext.purs +2/−0
examples/passing/RowSynonyms.purs +0/−46
examples/passing/RuntimeScopeIssue.purs +5/−5
examples/passing/ScopedTypeVariables.purs +4/−2
examples/passing/Sequence.purs +7/−4
examples/passing/SequenceDesugared.purs +22/−19
examples/passing/ShadowedRename.purs +4/−11
examples/passing/ShadowedTCO.purs +3/−1
examples/passing/ShadowedTCOLet.purs +4/−2
examples/passing/SignedNumericLiterals.purs +12/−10
examples/passing/Superclasses1.purs +4/−2
examples/passing/Superclasses2.purs +7/−6
examples/passing/Superclasses3.purs +3/−3
examples/passing/TCOCase.purs +5/−3
examples/passing/TailCall.purs +7/−5
examples/passing/Tick.purs +2/−0
examples/passing/TopLevelCase.purs +11/−11
examples/passing/TypeClassImport.purs +0/−18
examples/passing/TypeClassMemberOrderChange.purs +2/−0
examples/passing/TypeClasses.purs +7/−7
examples/passing/TypeClassesWithOverlappingTypeVariables.purs +6/−6
examples/passing/TypeDecl.purs +7/−7
examples/passing/TypeSynonymInData.purs +3/−1
examples/passing/TypeSynonyms.purs +20/−18
examples/passing/TypeWildcards.purs +3/−1
examples/passing/TypeWildcardsRecordExtension.purs +2/−0
examples/passing/TypedWhere.purs +10/−6
examples/passing/UnderscoreIdent.purs +2/−0
examples/passing/UnknownInTypeClassLookup.purs +3/−1
examples/passing/Where.purs +14/−14
examples/passing/iota.purs +4/−4
examples/passing/s.purs +4/−2
hierarchy/Main.hs +10/−9
prelude/prelude.purs +0/−1478
psc-bundle/Main.hs +621/−0
psc-docs/Main.hs +177/−191
psc-docs/Tags.hs +1/−1
psc-make/Main.hs +0/−177
psc-publish/BoxesHelpers.hs +38/−0
psc-publish/ErrorsWarnings.hs +359/−0
psc-publish/Main.hs +286/−0
psc-publish/Utils.hs +22/−0
psc/Main.hs +100/−133
psc/Make.hs +140/−0
psci/Commands.hs +0/−78
psci/Completion.hs +224/−0
psci/Directive.hs +81/−45
psci/IO.hs +21/−0
psci/Main.hs +0/−702
psci/Make.hs +127/−0
psci/PSCi.hs +569/−0
psci/Parser.hs +49/−34
psci/Types.hs +181/−0
psci/main/Main.hs +6/−0
psci/tests/Main.hs +150/−0
purescript.cabal +95/−27
src/Control/Monad/Supply.hs +1/−1
src/Control/Monad/Unify.hs +1/−1
src/Language/PureScript.hs +69/−144
src/Language/PureScript/AST.hs +1/−0
src/Language/PureScript/AST/Binders.hs +4/−5
src/Language/PureScript/AST/Declarations.hs +13/−51
src/Language/PureScript/AST/Exported.hs +136/−0
src/Language/PureScript/AST/Operators.hs +14/−2
src/Language/PureScript/AST/SourcePos.hs +25/−7
src/Language/PureScript/AST/Traversals.hs +1/−7
src/Language/PureScript/CodeGen/Externs.hs +21/−6
src/Language/PureScript/CodeGen/JS.hs +54/−54
src/Language/PureScript/CodeGen/JS/AST.hs +30/−24
src/Language/PureScript/CodeGen/JS/Optimizer.hs +10/−7
src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs +162/−46
src/Language/PureScript/CodeGen/JS/Optimizer/MagicDo.hs +3/−3
src/Language/PureScript/CodeGen/JS/Optimizer/TCO.hs +31/−6
src/Language/PureScript/Constants.hs +64/−22
src/Language/PureScript/CoreFn/Desugar.hs +17/−7
src/Language/PureScript/CoreFn/Literals.hs +4/−0
src/Language/PureScript/CoreFn/Meta.hs +5/−1
src/Language/PureScript/CoreFn/Module.hs +1/−2
src/Language/PureScript/DeadCodeElimination.hs +0/−102
src/Language/PureScript/Docs.hs +14/−0
src/Language/PureScript/Docs/AsMarkdown.hs +124/−0
src/Language/PureScript/Docs/Convert.hs +228/−0
src/Language/PureScript/Docs/ParseAndDesugar.hs +120/−0
src/Language/PureScript/Docs/Render.hs +127/−0
src/Language/PureScript/Docs/RenderedCode.hs +11/−0
src/Language/PureScript/Docs/RenderedCode/Render.hs +179/−0
src/Language/PureScript/Docs/RenderedCode/Types.hs +191/−0
src/Language/PureScript/Docs/Types.hs +472/−0
src/Language/PureScript/Docs/Utils/MonoidExtras.hs +9/−0
src/Language/PureScript/Environment.hs +52/−33
src/Language/PureScript/Errors.hs +544/−275
src/Language/PureScript/Kinds.hs +13/−1
src/Language/PureScript/Linter.hs +82/−0
src/Language/PureScript/ModuleDependencies.hs +5/−4
src/Language/PureScript/Names.hs +18/−1
src/Language/PureScript/Options.hs +6/−49
src/Language/PureScript/Parser.hs +1/−0
src/Language/PureScript/Parser/Common.hs +5/−0
src/Language/PureScript/Parser/Declarations.hs +51/−26
src/Language/PureScript/Parser/JS.hs +59/−0
src/Language/PureScript/Parser/Lexer.hs +24/−4
src/Language/PureScript/Parser/Types.hs +8/−5
src/Language/PureScript/Pretty/Types.hs +1/−3
src/Language/PureScript/Pretty/Values.hs +8/−14
src/Language/PureScript/Renamer.hs +11/−9
src/Language/PureScript/Sugar.hs +1/−1
src/Language/PureScript/Sugar/BindingGroups.hs +1/−2
src/Language/PureScript/Sugar/CaseDeclarations.hs +39/−20
src/Language/PureScript/Sugar/DoNotation.hs +4/−7
src/Language/PureScript/Sugar/Names.hs +85/−17
src/Language/PureScript/Sugar/ObjectWildcards.hs +1/−1
src/Language/PureScript/Sugar/Operators.hs +1/−1
src/Language/PureScript/Sugar/TypeClasses.hs +5/−5
src/Language/PureScript/Sugar/TypeDeclarations.hs +1/−2
src/Language/PureScript/TypeChecker.hs +11/−15
src/Language/PureScript/TypeChecker/Entailment.hs +49/−37
src/Language/PureScript/TypeChecker/Kinds.hs +2/−1
src/Language/PureScript/TypeChecker/Monad.hs +56/−25
src/Language/PureScript/TypeChecker/Rows.hs +2/−1
src/Language/PureScript/TypeChecker/Skolems.hs +2/−2
src/Language/PureScript/TypeChecker/Subsumption.hs +2/−1
src/Language/PureScript/TypeChecker/Synonyms.hs +13/−19
src/Language/PureScript/TypeChecker/Types.hs +33/−22
src/Language/PureScript/TypeChecker/Unify.hs +4/−1
src/Language/PureScript/Types.hs +8/−11
tests/Main.hs +139/−61

LICENSE view

@@ -1,684 +1,1869 @@ The MIT License (MIT) -Copyright (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors--Permission is hereby granted, free of charge, to any person obtaining a copy of-this software and associated documentation files (the "Software"), to deal in-the Software without restriction, including without limitation the rights to-use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of-the Software, and to permit persons to whom the Software is furnished to do so,-subject to the following conditions:--The above copyright notice and this permission notice shall be included in all-copies or substantial portions of the Software.--THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS-FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR-COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER-IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN-CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.--PureScript uses the following Haskell library packages. Their license files follow.--  base-  containers-  directory-  file-embed-  filepath-  haskeline-  monad-unify-  mtl-  optparse-applicative-  parsec-  pattern-arrows-  process-  time-  transformers-  unordered-containers-  utf8-string-  split-  boxes--base LICENSE file:--  This library (libraries/base) is derived from code from several-  sources:--    * Code from the GHC project which is largely (c) The University of-      Glasgow, and distributable under a BSD-style license (see below),--    * Code from the Haskell 98 Report which is (c) Simon Peyton Jones-      and freely redistributable (but see the full license for-      restrictions).--    * Code from the Haskell Foreign Function Interface specification,-      which is (c) Manuel M. T. Chakravarty and freely redistributable-      (but see the full license for restrictions).--  The full text of these licenses is reproduced below.  All of the-  licenses are BSD-style or compatible.--  -------------------------------------------------------------------------------  The Glasgow Haskell Compiler License--  Copyright 2004, The University Court of the University of Glasgow.-  All rights reserved.--  Redistribution and use in source and binary forms, with or without-  modification, are permitted provided that the following conditions are met:--  - Redistributions of source code must retain the above copyright notice,-  this list of conditions and the following disclaimer.--  - Redistributions in binary form must reproduce the above copyright notice,-  this list of conditions and the following disclaimer in the documentation-  and/or other materials provided with the distribution.--  - Neither name of the University nor the names of its contributors may be-  used to endorse or promote products derived from this software without-  specific prior written permission.--  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF-  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,-  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND-  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE-  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE-  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL-  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR-  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER-  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT-  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY-  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH-  DAMAGE.--  -------------------------------------------------------------------------------  Code derived from the document "Report on the Programming Language-  Haskell 98", is distributed under the following license:--    Copyright (c) 2002 Simon Peyton Jones--    The authors intend this Report to belong to the entire Haskell-    community, and so we grant permission to copy and distribute it for-    any purpose, provided that it is reproduced in its entirety,-    including this Notice.  Modified versions of this Report may also be-    copied and distributed for any purpose, provided that the modified-    version is clearly presented as such, and that it does not claim to-    be a definition of the Haskell 98 Language.--  -------------------------------------------------------------------------------  Code derived from the document "The Haskell 98 Foreign Function-  Interface, An Addendum to the Haskell 98 Report" is distributed under-  the following license:--    Copyright (c) 2002 Manuel M. T. Chakravarty--    The authors intend this Report to belong to the entire Haskell-    community, and so we grant permission to copy and distribute it for-    any purpose, provided that it is reproduced in its entirety,-    including this Notice.  Modified versions of this Report may also be-    copied and distributed for any purpose, provided that the modified-    version is clearly presented as such, and that it does not claim to-    be a definition of the Haskell 98 Foreign Function Interface.--  -------------------------------------------------------------------------------containers LICENSE file:--  The Glasgow Haskell Compiler License--  Copyright 2004, The University Court of the University of Glasgow.-  All rights reserved.--  Redistribution and use in source and binary forms, with or without-  modification, are permitted provided that the following conditions are met:--  - Redistributions of source code must retain the above copyright notice,-  this list of conditions and the following disclaimer.--  - Redistributions in binary form must reproduce the above copyright notice,-  this list of conditions and the following disclaimer in the documentation-  and/or other materials provided with the distribution.--  - Neither name of the University nor the names of its contributors may be-  used to endorse or promote products derived from this software without-  specific prior written permission.--  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF-  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,-  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND-  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE-  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE-  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL-  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR-  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER-  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT-  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY-  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH-  DAMAGE.--directory LICENSE file:--  This library (libraries/base) is derived from code from two-  sources:--    * Code from the GHC project which is largely (c) The University of-      Glasgow, and distributable under a BSD-style license (see below),--    * Code from the Haskell 98 Report which is (c) Simon Peyton Jones-      and freely redistributable (but see the full license for-      restrictions).--  The full text of these licenses is reproduced below.  Both of the-  licenses are BSD-style or compatible.--  -------------------------------------------------------------------------------  The Glasgow Haskell Compiler License--  Copyright 2004, The University Court of the University of Glasgow.-  All rights reserved.--  Redistribution and use in source and binary forms, with or without-  modification, are permitted provided that the following conditions are met:--  - Redistributions of source code must retain the above copyright notice,-  this list of conditions and the following disclaimer.--  - Redistributions in binary form must reproduce the above copyright notice,-  this list of conditions and the following disclaimer in the documentation-  and/or other materials provided with the distribution.--  - Neither name of the University nor the names of its contributors may be-  used to endorse or promote products derived from this software without-  specific prior written permission.--  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF-  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,-  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND-  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE-  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE-  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL-  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR-  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER-  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT-  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY-  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH-  DAMAGE.--  -------------------------------------------------------------------------------  Code derived from the document "Report on the Programming Language-  Haskell 98", is distributed under the following license:--    Copyright (c) 2002 Simon Peyton Jones--    The authors intend this Report to belong to the entire Haskell-    community, and so we grant permission to copy and distribute it for-    any purpose, provided that it is reproduced in its entirety,-    including this Notice.  Modified versions of this Report may also be-    copied and distributed for any purpose, provided that the modified-    version is clearly presented as such, and that it does not claim to-    be a definition of the Haskell 98 Language.--  -------------------------------------------------------------------------------file-embed LICENSE file:--  The following license covers this documentation, and the source code, except-  where otherwise indicated.--  Copyright 2008, Michael Snoyman. All rights reserved.--  Redistribution and use in source and binary forms, with or without-  modification, are permitted provided that the following conditions are met:--  * Redistributions of source code must retain the above copyright notice, this-    list of conditions and the following disclaimer.--  * Redistributions in binary form must reproduce the above copyright notice,-    this list of conditions and the following disclaimer in the documentation-    and/or other materials provided with the distribution.--  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR-  IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF-  MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO-  EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,-  INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT-  NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,-  OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF-  LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE-  OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF-  ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.--filepath LICENSE file:--  Copyright Neil Mitchell 2005-2007.-  All rights reserved.--  Redistribution and use in source and binary forms, with or without-  modification, are permitted provided that the following conditions are-  met:--      * Redistributions of source code must retain the above copyright-        notice, this list of conditions and the following disclaimer.--      * Redistributions in binary form must reproduce the above-        copyright notice, this list of conditions and the following-        disclaimer in the documentation and/or other materials provided-        with the distribution.--      * Neither the name of Neil Mitchell nor the names of other-        contributors may be used to endorse or promote products derived-        from this software without specific prior written permission.--  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.--haskeline LICENSE file:--  Copyright 2007-2009, Judah Jacobson.-  All Rights Reserved.--  Redistribution and use in source and binary forms, with or without-  modification, are permitted provided that the following conditions are met:--  - Redistribution of source code must retain the above copyright notice,-  this list of conditions and the following disclaimer.--  - Redistribution in binary form must reproduce the above copyright notice,-  this list of conditions and the following disclaimer in the documentation-  and/or other materials provided with the distribution.--  THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS "AS IS" AND ANY-  EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED-  WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE-  DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR THE CONTRIBUTORS BE LIABLE-  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL-  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR-  SERVICES; LOSS OF USE, DATA OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER-  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,-  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE-  USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.--monad-unify LICENSE file:--  The MIT License (MIT)--  Copyright (c) 2013 Phil Freeman--  Permission is hereby granted, free of charge, to any person obtaining a copy of-  this software and associated documentation files (the "Software"), to deal in-  the Software without restriction, including without limitation the rights to-  use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of-  the Software, and to permit persons to whom the Software is furnished to do so,-  subject to the following conditions:--  The above copyright notice and this permission notice shall be included in all-  copies or substantial portions of the Software.--  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR-  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS-  FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR-  COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER-  IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN-  CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.--mtl LICENSE file:--  The Glasgow Haskell Compiler License--  Copyright 2004, The University Court of the University of Glasgow.-  All rights reserved.--  Redistribution and use in source and binary forms, with or without-  modification, are permitted provided that the following conditions are met:--  - Redistributions of source code must retain the above copyright notice,-  this list of conditions and the following disclaimer.--  - Redistributions in binary form must reproduce the above copyright notice,-  this list of conditions and the following disclaimer in the documentation-  and/or other materials provided with the distribution.--  - Neither name of the University nor the names of its contributors may be-  used to endorse or promote products derived from this software without-  specific prior written permission.--  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF-  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,-  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND-  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE-  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE-  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL-  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR-  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER-  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT-  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY-  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH-  DAMAGE.--optparse-applicative LICENSE file:--  Copyright (c) 2012, Paolo Capriotti--  All rights reserved.--  Redistribution and use in source and binary forms, with or without-  modification, are permitted provided that the following conditions are met:--      * Redistributions of source code must retain the above copyright-        notice, this list of conditions and the following disclaimer.--      * Redistributions in binary form must reproduce the above-        copyright notice, this list of conditions and the following-        disclaimer in the documentation and/or other materials provided-        with the distribution.--      * Neither the name of Paolo Capriotti nor the names of other-        contributors may be used to endorse or promote products derived-        from this software without specific prior written permission.--  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.--parsec LICENSE file:--  Copyright 1999-2000, Daan Leijen; 2007, Paolo Martini. All rights reserved.--  Redistribution and use in source and binary forms, with or without-  modification, are permitted provided that the following conditions are met:--  * Redistributions of source code must retain the above copyright notice,-    this list of conditions and the following disclaimer.-  * Redistributions in binary form must reproduce the above copyright-    notice, this list of conditions and the following disclaimer in the-    documentation and/or other materials provided with the distribution.--  This software is provided by the copyright holders "as is" and any express or-  implied warranties, including, but not limited to, the implied warranties of-  merchantability and fitness for a particular purpose are disclaimed. In no-  event shall the copyright holders be liable for any direct, indirect,-  incidental, special, exemplary, or consequential damages (including, but not-  limited to, procurement of substitute goods or services; loss of use, data,-  or profits; or business interruption) however caused and on any theory of-  liability, whether in contract, strict liability, or tort (including-  negligence or otherwise) arising in any way out of the use of this software,-  even if advised of the possibility of such damage.--pattern-arrows LICENSE file:--  The MIT License (MIT)--  Copyright (c) 2013 Phil Freeman--  Permission is hereby granted, free of charge, to any person obtaining a copy of-  this software and associated documentation files (the "Software"), to deal in-  the Software without restriction, including without limitation the rights to-  use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of-  the Software, and to permit persons to whom the Software is furnished to do so,-  subject to the following conditions:--  The above copyright notice and this permission notice shall be included in all-  copies or substantial portions of the Software.--  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR-  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS-  FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR-  COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER-  IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN-  CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.--process LICENSE file:--  This library (libraries/process) is derived from code from two-  sources:--    * Code from the GHC project which is largely (c) The University of-      Glasgow, and distributable under a BSD-style license (see below),--    * Code from the Haskell 98 Report which is (c) Simon Peyton Jones-      and freely redistributable (but see the full license for-      restrictions).--  The full text of these licenses is reproduced below.  Both of the-  licenses are BSD-style or compatible.--  -------------------------------------------------------------------------------  The Glasgow Haskell Compiler License--  Copyright 2004, The University Court of the University of Glasgow.-  All rights reserved.--  Redistribution and use in source and binary forms, with or without-  modification, are permitted provided that the following conditions are met:--  - Redistributions of source code must retain the above copyright notice,-  this list of conditions and the following disclaimer.--  - Redistributions in binary form must reproduce the above copyright notice,-  this list of conditions and the following disclaimer in the documentation-  and/or other materials provided with the distribution.--  - Neither name of the University nor the names of its contributors may be-  used to endorse or promote products derived from this software without-  specific prior written permission.--  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF-  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,-  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND-  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE-  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE-  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL-  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR-  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER-  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT-  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY-  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH-  DAMAGE.--  -------------------------------------------------------------------------------  Code derived from the document "Report on the Programming Language-  Haskell 98", is distributed under the following license:--    Copyright (c) 2002 Simon Peyton Jones--    The authors intend this Report to belong to the entire Haskell-    community, and so we grant permission to copy and distribute it for-    any purpose, provided that it is reproduced in its entirety,-    including this Notice.  Modified versions of this Report may also be-    copied and distributed for any purpose, provided that the modified-    version is clearly presented as such, and that it does not claim to-    be a definition of the Haskell 98 Language.--  -------------------------------------------------------------------------------time LICENSE file:--  TimeLib is Copyright (c) Ashley Yakeley, 2004-2014. All rights reserved.-  Certain sections are Copyright 2004, The University Court of the University of Glasgow. All rights reserved.--  Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:--  - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.--  - Neither name of the copyright holders nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.--  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.--transformers LICENSE file:--  The Glasgow Haskell Compiler License--  Copyright 2004, The University Court of the University of Glasgow.-  All rights reserved.--  Redistribution and use in source and binary forms, with or without-  modification, are permitted provided that the following conditions are met:--  - Redistributions of source code must retain the above copyright notice,-  this list of conditions and the following disclaimer.--  - Redistributions in binary form must reproduce the above copyright notice,-  this list of conditions and the following disclaimer in the documentation-  and/or other materials provided with the distribution.--  - Neither name of the University nor the names of its contributors may be-  used to endorse or promote products derived from this software without-  specific prior written permission.--  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF-  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,-  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND-  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE-  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE-  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL-  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR-  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER-  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT-  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY-  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH-  DAMAGE.--unordered-containers LICENSE file:--  Copyright (c) 2010, Johan Tibell--  All rights reserved.--  Redistribution and use in source and binary forms, with or without-  modification, are permitted provided that the following conditions are met:--      * Redistributions of source code must retain the above copyright-        notice, this list of conditions and the following disclaimer.--      * Redistributions in binary form must reproduce the above-        copyright notice, this list of conditions and the following-        disclaimer in the documentation and/or other materials provided-        with the distribution.--      * Neither the name of Johan Tibell nor the names of other-        contributors may be used to endorse or promote products derived-        from this software without specific prior written permission.--  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.--utf8-string LICENSE file:--  * Copyright (c) 2007, Galois Inc.-  * All rights reserved.-  *-  * Redistribution and use in source and binary forms, with or without-  * modification, are permitted provided that the following conditions are met:-  *     * Redistributions of source code must retain the above copyright-  *       notice, this list of conditions and the following disclaimer.-  *     * Redistributions in binary form must reproduce the above copyright-  *       notice, this list of conditions and the following disclaimer in the-  *       documentation and/or other materials provided with the distribution.-  *     * Neither the name of Galois Inc. nor the-  *       names of its contributors may be used to endorse or promote products-  *       derived from this software without specific prior written permission.-  *-  * THIS SOFTWARE IS PROVIDED BY Galois Inc. ``AS IS'' AND ANY-  * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED-  * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE-  * DISCLAIMED. IN NO EVENT SHALL Galois Inc. BE LIABLE FOR ANY-  * DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES-  * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;-  * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND-  * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-  * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS-  * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.--split LICENSE file:--  Copyright (c) 2008 Brent Yorgey, Louis Wasserman--  All rights reserved.--  Redistribution and use in source and binary forms, with or without-  modification, are permitted provided that the following conditions-  are met:-  1. Redistributions of source code must retain the above copyright-     notice, this list of conditions and the following disclaimer.-  2. Redistributions in binary form must reproduce the above copyright-     notice, this list of conditions and the following disclaimer in the-     documentation and/or other materials provided with the distribution.-  3. Neither the name of the author nor the names of other contributors-     may be used to endorse or promote products derived from this software-     without specific prior written permission.--  THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND-  ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE-  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE-  ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE-  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL-  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS-  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)-  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT-  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY-  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF-  SUCH DAMAGE.--boxes LICENSE file:--  Copyright (c) Brent Yorgey 2008--  Redistribution and use in source and binary forms, with or without-  modification, are permitted provided that the following conditions-  are met:-  1. Redistributions of source code must retain the above copyright-     notice, this list of conditions and the following disclaimer.-  2. Redistributions in binary form must reproduce the above copyright-     notice, this list of conditions and the following disclaimer in the-     documentation and/or other materials provided with the distribution.-  3. Neither the name of the author nor the names of other contributors-     may be used to endorse or promote products derived from this software-     without specific prior written permission.--  All other rights are reserved.--  THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND-  ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE-  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE-  ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE-  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL-  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS-  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)-  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT-  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY-  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF-  SUCH DAMAGE.+Copyright (c) 2013-15 Phil Freeman, (c) 2014-2015 Gary Burgess, and other+contributors++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of+the Software, and to permit persons to whom the Software is furnished to do so,+subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS+FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR+COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER+IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.++PureScript uses the following Haskell library packages. Their license files follow.++  Glob+  HUnit+  aeson+  aeson-better-errors+  ansi-terminal+  ansi-wl-pprint+  array+  attoparsec+  base+  blaze-builder+  bower-json+  boxes+  bytestring+  containers+  deepseq+  directory+  dlist+  filepath+  ghc-prim+  hashable+  haskeline+  integer-gmp+  language-javascript+  mtl+  nats+  old-locale+  optparse-applicative+  parsec+  pattern-arrows+  pretty+  primitive+  process+  rts+  safe+  scientific+  semigroups+  split+  syb+  template-haskell+  terminfo+  text+  time+  transformers+  transformers-compat+  unix+  unordered-containers+  utf8-string+  vector+  void++Glob LICENSE file:++  The code in Glob is released under the license below. Copyrights to parts of+  the code are held by whoever wrote the code in question: see CREDITS.txt for a+  list of authors.++  Copyright (c) 2008-2012 <authors>+  All rights reserved.++  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+      * Redistributions of source code must retain the above copyright+        notice, this list of conditions and the following disclaimer.+      * Redistributions in binary form must reproduce the above copyright+        notice, this list of conditions and the following disclaimer in the+        documentation and/or other materials provided with the distribution.+      * Neither the name of the project nor the names of its contributors may be+        used to endorse or promote products derived from this software without+        specific prior written permission.++  THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR IMPLIED+  WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+  MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO+  EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,+  INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR+  PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+  LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE+  OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF+  ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++HUnit LICENSE file:++  HUnit is Copyright (c) Dean Herington, 2002, all rights reserved,+  and is distributed as free software under the following license.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions+  are met:+  +  - Redistributions of source code must retain the above copyright+  notice, this list of conditions, and the following disclaimer.+  +  - Redistributions in binary form must reproduce the above copyright+  notice, this list of conditions, and the following disclaimer in the+  documentation and/or other materials provided with the distribution.+  +  - The names of the copyright holders may not be used to endorse or+  promote products derived from this software without specific prior+  written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY+  EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+  PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE+  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR+  BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,+  WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE+  OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN+  IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++aeson LICENSE file:++  Copyright (c) 2011, MailRank, Inc.+  +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions+  are met:+  +  1. Redistributions of source code must retain the above copyright+     notice, this list of conditions and the following disclaimer.+  +  2. Redistributions in binary form must reproduce the above copyright+     notice, this list of conditions and the following disclaimer in the+     documentation and/or other materials provided with the distribution.+  +  3. Neither the name of the author nor the names of his contributors+     may be used to endorse or promote products derived from this software+     without specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS+  OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+  WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+  DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+  ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+  STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+  ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+  POSSIBILITY OF SUCH DAMAGE.++aeson-better-errors LICENSE file:++  Copyright (c) 2015 Harry Garrood+  +  Permission is hereby granted, free of charge, to any person obtaining+  a copy of this software and associated documentation files (the+  "Software"), to deal in the Software without restriction, including+  without limitation the rights to use, copy, modify, merge, publish,+  distribute, sublicense, and/or sell copies of the Software, and to+  permit persons to whom the Software is furnished to do so, subject to+  the following conditions:+  +  The above copyright notice and this permission notice shall be included+  in all copies or substantial portions of the Software.+  +  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+  EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+  MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+  CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+  TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+  SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.++ansi-terminal LICENSE file:++  Copyright (c) 2008, Maximilian Bolingbroke+  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without modification, are permitted+  provided that the following conditions are met:+  +      * Redistributions of source code must retain the above copyright notice, this list of+        conditions and the following disclaimer.+      * Redistributions in binary form must reproduce the above copyright notice, this list of+        conditions and the following disclaimer in the documentation and/or other materials+        provided with the distribution.+      * Neither the name of Maximilian Bolingbroke nor the names of other contributors may be used to+        endorse or promote products derived from this software without specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR+  IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR+  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER+  IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT+  OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++ansi-wl-pprint LICENSE file:++  Copyright 2008, Daan Leijen and Max Bolingbroke. All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are+  met:+  +    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.+  +    * Redistributions in binary form must reproduce the above copyright+      notice, this list of conditions and the following disclaimer in+      the documentation and/or other materials provided with the+      distribution.+  +  This software is provided by the copyright holders "as is" and any+  express or implied warranties, including, but not limited to, the+  implied warranties of merchantability and fitness for a particular+  purpose are disclaimed. In no event shall the copyright holders be+  liable for any direct, indirect, incidental, special, exemplary, or+  consequential damages (including, but not limited to, procurement of+  substitute goods or services; loss of use, data, or profits; or+  business interruption) however caused and on any theory of liability,+  whether in contract, strict liability, or tort (including negligence+  or otherwise) arising in any way out of the use of this software, even+  if advised of the possibility of such damage.++array LICENSE file:++  This library (libraries/base) is derived from code from several+  sources: +  +    * Code from the GHC project which is largely (c) The University of+      Glasgow, and distributable under a BSD-style license (see below),+  +    * Code from the Haskell 98 Report which is (c) Simon Peyton Jones+      and freely redistributable (but see the full license for+      restrictions).+  +    * Code from the Haskell Foreign Function Interface specification,+      which is (c) Manuel M. T. Chakravarty and freely redistributable+      (but see the full license for restrictions).+  +  The full text of these licenses is reproduced below.  All of the+  licenses are BSD-style or compatible.+  +  -----------------------------------------------------------------------------+  +  The Glasgow Haskell Compiler License+  +  Copyright 2004, The University Court of the University of Glasgow. +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +  - Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.+   +  - Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.+   +  - Neither name of the University nor the names of its contributors may be+  used to endorse or promote products derived from this software without+  specific prior written permission. +  +  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+  DAMAGE.+  +  -----------------------------------------------------------------------------+  +  Code derived from the document "Report on the Programming Language+  Haskell 98", is distributed under the following license:+  +    Copyright (c) 2002 Simon Peyton Jones+  +    The authors intend this Report to belong to the entire Haskell+    community, and so we grant permission to copy and distribute it for+    any purpose, provided that it is reproduced in its entirety,+    including this Notice.  Modified versions of this Report may also be+    copied and distributed for any purpose, provided that the modified+    version is clearly presented as such, and that it does not claim to+    be a definition of the Haskell 98 Language.+  +  -----------------------------------------------------------------------------+  +  Code derived from the document "The Haskell 98 Foreign Function+  Interface, An Addendum to the Haskell 98 Report" is distributed under+  the following license:+  +    Copyright (c) 2002 Manuel M. T. Chakravarty+  +    The authors intend this Report to belong to the entire Haskell+    community, and so we grant permission to copy and distribute it for+    any purpose, provided that it is reproduced in its entirety,+    including this Notice.  Modified versions of this Report may also be+    copied and distributed for any purpose, provided that the modified+    version is clearly presented as such, and that it does not claim to+    be a definition of the Haskell 98 Foreign Function Interface.+  +  -----------------------------------------------------------------------------++attoparsec LICENSE file:++  Copyright (c) Lennart Kolmodin+  +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions+  are met:+  +  1. Redistributions of source code must retain the above copyright+     notice, this list of conditions and the following disclaimer.+  +  2. Redistributions in binary form must reproduce the above copyright+     notice, this list of conditions and the following disclaimer in the+     documentation and/or other materials provided with the distribution.+  +  3. Neither the name of the author nor the names of his contributors+     may be used to endorse or promote products derived from this software+     without specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS+  OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+  WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+  DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+  ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+  STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+  ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+  POSSIBILITY OF SUCH DAMAGE.++base LICENSE file:++  This library (libraries/base) is derived from code from several+  sources: +  +    * Code from the GHC project which is largely (c) The University of+      Glasgow, and distributable under a BSD-style license (see below),+  +    * Code from the Haskell 98 Report which is (c) Simon Peyton Jones+      and freely redistributable (but see the full license for+      restrictions).+  +    * Code from the Haskell Foreign Function Interface specification,+      which is (c) Manuel M. T. Chakravarty and freely redistributable+      (but see the full license for restrictions).+  +  The full text of these licenses is reproduced below.  All of the+  licenses are BSD-style or compatible.+  +  -----------------------------------------------------------------------------+  +  The Glasgow Haskell Compiler License+  +  Copyright 2004, The University Court of the University of Glasgow. +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +  - Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.+   +  - Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.+   +  - Neither name of the University nor the names of its contributors may be+  used to endorse or promote products derived from this software without+  specific prior written permission. +  +  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+  DAMAGE.+  +  -----------------------------------------------------------------------------+  +  Code derived from the document "Report on the Programming Language+  Haskell 98", is distributed under the following license:+  +    Copyright (c) 2002 Simon Peyton Jones+  +    The authors intend this Report to belong to the entire Haskell+    community, and so we grant permission to copy and distribute it for+    any purpose, provided that it is reproduced in its entirety,+    including this Notice.  Modified versions of this Report may also be+    copied and distributed for any purpose, provided that the modified+    version is clearly presented as such, and that it does not claim to+    be a definition of the Haskell 98 Language.+  +  -----------------------------------------------------------------------------+  +  Code derived from the document "The Haskell 98 Foreign Function+  Interface, An Addendum to the Haskell 98 Report" is distributed under+  the following license:+  +    Copyright (c) 2002 Manuel M. T. Chakravarty+  +    The authors intend this Report to belong to the entire Haskell+    community, and so we grant permission to copy and distribute it for+    any purpose, provided that it is reproduced in its entirety,+    including this Notice.  Modified versions of this Report may also be+    copied and distributed for any purpose, provided that the modified+    version is clearly presented as such, and that it does not claim to+    be a definition of the Haskell 98 Foreign Function Interface.+  +  -----------------------------------------------------------------------------++blaze-builder LICENSE file:++  Copyright Jasper Van der Jeugt 2010, Simon Meier 2010 & 2011+  +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +      * Redistributions of source code must retain the above copyright+        notice, this list of conditions and the following disclaimer.+  +      * Redistributions in binary form must reproduce the above+        copyright notice, this list of conditions and the following+        disclaimer in the documentation and/or other materials provided+        with the distribution.+  +      * Neither the name of Jasper Van der Jeugt nor the names of other+        contributors may be used to endorse or promote products derived+        from this software without specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++bower-json LICENSE file:++  Copyright (c) 2015 Harry Garrood+  +  Permission is hereby granted, free of charge, to any person obtaining+  a copy of this software and associated documentation files (the+  "Software"), to deal in the Software without restriction, including+  without limitation the rights to use, copy, modify, merge, publish,+  distribute, sublicense, and/or sell copies of the Software, and to+  permit persons to whom the Software is furnished to do so, subject to+  the following conditions:+  +  The above copyright notice and this permission notice shall be included+  in all copies or substantial portions of the Software.+  +  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+  EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+  MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+  CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+  TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+  SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.++boxes LICENSE file:++  Copyright (c) Brent Yorgey 2008+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions+  are met:+  1. Redistributions of source code must retain the above copyright+     notice, this list of conditions and the following disclaimer.+  2. Redistributions in binary form must reproduce the above copyright+     notice, this list of conditions and the following disclaimer in the+     documentation and/or other materials provided with the distribution.+  3. Neither the name of the author nor the names of other contributors+     may be used to endorse or promote products derived from this software+     without specific prior written permission.+  +  All other rights are reserved.+  +  THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND+  ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+  ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+  SUCH DAMAGE.++bytestring LICENSE file:++  Copyright (c) Don Stewart 2005-2009+            (c) Duncan Coutts 2006-2015+            (c) David Roundy 2003-2005+            (c) Simon Meier 2010-2011+  +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions+  are met:+  1. Redistributions of source code must retain the above copyright+     notice, this list of conditions and the following disclaimer.+  2. Redistributions in binary form must reproduce the above copyright+     notice, this list of conditions and the following disclaimer in the+     documentation and/or other materials provided with the distribution.+  3. Neither the name of the author nor the names of his contributors+     may be used to endorse or promote products derived from this software+     without specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+  ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+  ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+  SUCH DAMAGE.++containers LICENSE file:++  The Glasgow Haskell Compiler License+  +  Copyright 2004, The University Court of the University of Glasgow.+  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +  - Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.+  +  - Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.+  +  - Neither name of the University nor the names of its contributors may be+  used to endorse or promote products derived from this software without+  specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+  DAMAGE.++deepseq LICENSE file:++  This library (deepseq) is derived from code from the GHC project which+  is largely (c) The University of Glasgow, and distributable under a+  BSD-style license (see below).+  +  -----------------------------------------------------------------------------+  +  The Glasgow Haskell Compiler License+  +  Copyright 2001-2009, The University Court of the University of Glasgow. +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +  - Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.+   +  - Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.+   +  - Neither name of the University nor the names of its contributors may be+  used to endorse or promote products derived from this software without+  specific prior written permission. +  +  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+  DAMAGE.+  +  -----------------------------------------------------------------------------++directory LICENSE file:++  This library (libraries/base) is derived from code from two+  sources: +  +    * Code from the GHC project which is largely (c) The University of+      Glasgow, and distributable under a BSD-style license (see below),+  +    * Code from the Haskell 98 Report which is (c) Simon Peyton Jones+      and freely redistributable (but see the full license for+      restrictions).+  +  The full text of these licenses is reproduced below.  Both of the+  licenses are BSD-style or compatible.+  +  -----------------------------------------------------------------------------+  +  The Glasgow Haskell Compiler License+  +  Copyright 2004, The University Court of the University of Glasgow. +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +  - Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.+   +  - Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.+   +  - Neither name of the University nor the names of its contributors may be+  used to endorse or promote products derived from this software without+  specific prior written permission. +  +  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+  DAMAGE.+  +  -----------------------------------------------------------------------------+  +  Code derived from the document "Report on the Programming Language+  Haskell 98", is distributed under the following license:+  +    Copyright (c) 2002 Simon Peyton Jones+  +    The authors intend this Report to belong to the entire Haskell+    community, and so we grant permission to copy and distribute it for+    any purpose, provided that it is reproduced in its entirety,+    including this Notice.  Modified versions of this Report may also be+    copied and distributed for any purpose, provided that the modified+    version is clearly presented as such, and that it does not claim to+    be a definition of the Haskell 98 Language.+  +  -----------------------------------------------------------------------------++dlist LICENSE file:++  Copyright (c) 2006-2009 Don Stewart, 2013-2014 Sean Leather+  +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are+  met:+  +      * Redistributions of source code must retain the above copyright+        notice, this list of conditions and the following disclaimer.+  +      * Redistributions in binary form must reproduce the above+        copyright notice, this list of conditions and the following+        disclaimer in the documentation and/or other materials provided+        with the distribution.+  +      * Neither the name of Don Stewart nor the names of other+        contributors may be used to endorse or promote products derived+        from this software without specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++filepath LICENSE file:++  Copyright Neil Mitchell 2005-2015.+  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are+  met:+  +      * Redistributions of source code must retain the above copyright+        notice, this list of conditions and the following disclaimer.+  +      * Redistributions in binary form must reproduce the above+        copyright notice, this list of conditions and the following+        disclaimer in the documentation and/or other materials provided+        with the distribution.+  +      * Neither the name of Neil Mitchell nor the names of other+        contributors may be used to endorse or promote products derived+        from this software without specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++ghc-prim LICENSE file:++  This library (libraries/ghc-prim) is derived from code from several+  sources: +  +    * Code from the GHC project which is largely (c) The University of+      Glasgow, and distributable under a BSD-style license (see below),+  +    * Code from the Haskell 98 Report which is (c) Simon Peyton Jones+      and freely redistributable (but see the full license for+      restrictions).+  +  The full text of these licenses is reproduced below.  All of the+  licenses are BSD-style or compatible.+  +  -----------------------------------------------------------------------------+  +  The Glasgow Haskell Compiler License+  +  Copyright 2004, The University Court of the University of Glasgow. +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +  - Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.+   +  - Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.+   +  - Neither name of the University nor the names of its contributors may be+  used to endorse or promote products derived from this software without+  specific prior written permission. +  +  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+  DAMAGE.+  +  -----------------------------------------------------------------------------+  +  Code derived from the document "Report on the Programming Language+  Haskell 98", is distributed under the following license:+  +    Copyright (c) 2002 Simon Peyton Jones+  +    The authors intend this Report to belong to the entire Haskell+    community, and so we grant permission to copy and distribute it for+    any purpose, provided that it is reproduced in its entirety,+    including this Notice.  Modified versions of this Report may also be+    copied and distributed for any purpose, provided that the modified+    version is clearly presented as such, and that it does not claim to+    be a definition of the Haskell 98 Language.+  ++hashable LICENSE file:++  Copyright Milan Straka 2010+  +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +      * Redistributions of source code must retain the above copyright+        notice, this list of conditions and the following disclaimer.+  +      * Redistributions in binary form must reproduce the above+        copyright notice, this list of conditions and the following+        disclaimer in the documentation and/or other materials provided+        with the distribution.+  +      * Neither the name of Milan Straka nor the names of other+        contributors may be used to endorse or promote products derived+        from this software without specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++haskeline LICENSE file:++  Copyright 2007-2009, Judah Jacobson.+  All Rights Reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +  - Redistribution of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.+  +  - Redistribution in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.+  +  THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS "AS IS" AND ANY+  EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+  WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+  DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR THE CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+  SERVICES; LOSS OF USE, DATA OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE+  USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++integer-gmp LICENSE file:++  Copyright (c) 2014, Herbert Valerio Riedel+  +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +      * Redistributions of source code must retain the above copyright+        notice, this list of conditions and the following disclaimer.+  +      * Redistributions in binary form must reproduce the above+        copyright notice, this list of conditions and the following+        disclaimer in the documentation and/or other materials provided+        with the distribution.+  +      * Neither the name of Herbert Valerio Riedel nor the names of other+        contributors may be used to endorse or promote products derived+        from this software without specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++language-javascript LICENSE file:++  Copyright (c)2010, Alan Zimmerman+  +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +      * Redistributions of source code must retain the above copyright+        notice, this list of conditions and the following disclaimer.+  +      * Redistributions in binary form must reproduce the above+        copyright notice, this list of conditions and the following+        disclaimer in the documentation and/or other materials provided+        with the distribution.+  +      * Neither the name of Alan Zimmerman nor the names of other+        contributors may be used to endorse or promote products derived+        from this software without specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++mtl LICENSE file:++  The Glasgow Haskell Compiler License+  +  Copyright 2004, The University Court of the University of Glasgow.+  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +  - Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.+  +  - Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.+  +  - Neither name of the University nor the names of its contributors may be+  used to endorse or promote products derived from this software without+  specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+  DAMAGE.++nats LICENSE file:++  Copyright 2011-2014 Edward Kmett+  +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions+  are met:+  +  1. Redistributions of source code must retain the above copyright+     notice, this list of conditions and the following disclaimer.+  +  2. Redistributions in binary form must reproduce the above copyright+     notice, this list of conditions and the following disclaimer in the+     documentation and/or other materials provided with the distribution.+  +  3. Neither the name of the author nor the names of his contributors+     may be used to endorse or promote products derived from this software+     without specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR+  IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+  WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+  DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+  ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+  STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+  ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+  POSSIBILITY OF SUCH DAMAGE.++old-locale LICENSE file:++  This library (libraries/base) is derived from code from two+  sources: +  +    * Code from the GHC project which is largely (c) The University of+      Glasgow, and distributable under a BSD-style license (see below),+  +    * Code from the Haskell 98 Report which is (c) Simon Peyton Jones+      and freely redistributable (but see the full license for+      restrictions).+  +  The full text of these licenses is reproduced below.  Both of the+  licenses are BSD-style or compatible.+  +  -----------------------------------------------------------------------------+  +  The Glasgow Haskell Compiler License+  +  Copyright 2004, The University Court of the University of Glasgow. +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +  - Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.+   +  - Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.+   +  - Neither name of the University nor the names of its contributors may be+  used to endorse or promote products derived from this software without+  specific prior written permission. +  +  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+  DAMAGE.+  +  -----------------------------------------------------------------------------+  +  Code derived from the document "Report on the Programming Language+  Haskell 98", is distributed under the following license:+  +    Copyright (c) 2002 Simon Peyton Jones+  +    The authors intend this Report to belong to the entire Haskell+    community, and so we grant permission to copy and distribute it for+    any purpose, provided that it is reproduced in its entirety,+    including this Notice.  Modified versions of this Report may also be+    copied and distributed for any purpose, provided that the modified+    version is clearly presented as such, and that it does not claim to+    be a definition of the Haskell 98 Language.+  +  -----------------------------------------------------------------------------++optparse-applicative LICENSE file:++  Copyright (c) 2012, Paolo Capriotti+  +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +      * Redistributions of source code must retain the above copyright+        notice, this list of conditions and the following disclaimer.+  +      * Redistributions in binary form must reproduce the above+        copyright notice, this list of conditions and the following+        disclaimer in the documentation and/or other materials provided+        with the distribution.+  +      * Neither the name of Paolo Capriotti nor the names of other+        contributors may be used to endorse or promote products derived+        from this software without specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++parsec LICENSE file:++  Copyright 1999-2000, Daan Leijen; 2007, Paolo Martini. All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +  * Redistributions of source code must retain the above copyright notice,+    this list of conditions and the following disclaimer.+  * Redistributions in binary form must reproduce the above copyright+    notice, this list of conditions and the following disclaimer in the+    documentation and/or other materials provided with the distribution.+  +  This software is provided by the copyright holders "as is" and any express or+  implied warranties, including, but not limited to, the implied warranties of+  merchantability and fitness for a particular purpose are disclaimed. In no+  event shall the copyright holders be liable for any direct, indirect,+  incidental, special, exemplary, or consequential damages (including, but not+  limited to, procurement of substitute goods or services; loss of use, data,+  or profits; or business interruption) however caused and on any theory of+  liability, whether in contract, strict liability, or tort (including+  negligence or otherwise) arising in any way out of the use of this software,+  even if advised of the possibility of such damage.++pattern-arrows LICENSE file:++  The MIT License (MIT)+  +  Copyright (c) 2013 Phil Freeman+  +  Permission is hereby granted, free of charge, to any person obtaining a copy of+  this software and associated documentation files (the "Software"), to deal in+  the Software without restriction, including without limitation the rights to+  use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of+  the Software, and to permit persons to whom the Software is furnished to do so,+  subject to the following conditions:+  +  The above copyright notice and this permission notice shall be included in all+  copies or substantial portions of the Software.+  +  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS+  FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR+  COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER+  IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+  CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.++pretty LICENSE file:++  This library (libraries/pretty) is derived from code from+  the GHC project which is largely (c) The University of+  Glasgow, and distributable under a BSD-style license (see below).+  +  -----------------------------------------------------------------------------+  +  The Glasgow Haskell Compiler License+  +  Copyright 2004, The University Court of the University of Glasgow. +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +  - Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.+   +  - Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.+   +  - Neither name of the University nor the names of its contributors may be+  used to endorse or promote products derived from this software without+  specific prior written permission. +  +  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+  DAMAGE.+  +  -----------------------------------------------------------------------------++primitive LICENSE file:++  Copyright (c) 2008-2009, Roman Leshchinskiy+  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +  - Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.+   +  - Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.+   +  - Neither name of the University nor the names of its contributors may be+  used to endorse or promote products derived from this software without+  specific prior written permission. +  +  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+  DAMAGE.+  ++process LICENSE file:++  This library (libraries/process) is derived from code from two+  sources: +  +    * Code from the GHC project which is largely (c) The University of+      Glasgow, and distributable under a BSD-style license (see below),+  +    * Code from the Haskell 98 Report which is (c) Simon Peyton Jones+      and freely redistributable (but see the full license for+      restrictions).+  +  The full text of these licenses is reproduced below.  Both of the+  licenses are BSD-style or compatible.+  +  -----------------------------------------------------------------------------+  +  The Glasgow Haskell Compiler License+  +  Copyright 2004, The University Court of the University of Glasgow. +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +  - Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.+   +  - Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.+   +  - Neither name of the University nor the names of its contributors may be+  used to endorse or promote products derived from this software without+  specific prior written permission. +  +  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+  DAMAGE.+  +  -----------------------------------------------------------------------------+  +  Code derived from the document "Report on the Programming Language+  Haskell 98", is distributed under the following license:+  +    Copyright (c) 2002 Simon Peyton Jones+  +    The authors intend this Report to belong to the entire Haskell+    community, and so we grant permission to copy and distribute it for+    any purpose, provided that it is reproduced in its entirety,+    including this Notice.  Modified versions of this Report may also be+    copied and distributed for any purpose, provided that the modified+    version is clearly presented as such, and that it does not claim to+    be a definition of the Haskell 98 Language.+  +  -----------------------------------------------------------------------------++rts LICENSE file:++  Package not found: No such package in package index++safe LICENSE file:++  Copyright Neil Mitchell 2007-2015.+  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are+  met:+  +      * Redistributions of source code must retain the above copyright+        notice, this list of conditions and the following disclaimer.+  +      * Redistributions in binary form must reproduce the above+        copyright notice, this list of conditions and the following+        disclaimer in the documentation and/or other materials provided+        with the distribution.+  +      * Neither the name of Neil Mitchell nor the names of other+        contributors may be used to endorse or promote products derived+        from this software without specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++scientific LICENSE file:++  Copyright (c) 2013, Bas van Dijk+  +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +      * Redistributions of source code must retain the above copyright+        notice, this list of conditions and the following disclaimer.+  +      * Redistributions in binary form must reproduce the above+        copyright notice, this list of conditions and the following+        disclaimer in the documentation and/or other materials provided+        with the distribution.+  +      * Neither the name of Bas van Dijk nor the names of other+        contributors may be used to endorse or promote products derived+        from this software without specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++semigroups LICENSE file:++  Copyright 2011-2015 Edward Kmett+  +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions+  are met:+  +  1. Redistributions of source code must retain the above copyright+     notice, this list of conditions and the following disclaimer.+  +  2. Redistributions in binary form must reproduce the above copyright+     notice, this list of conditions and the following disclaimer in the+     documentation and/or other materials provided with the distribution.+  +  THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR+  IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+  WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+  DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+  ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+  STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+  ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+  POSSIBILITY OF SUCH DAMAGE.++split LICENSE file:++  Copyright (c) 2008 Brent Yorgey, Louis Wasserman+  +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions+  are met:+  1. Redistributions of source code must retain the above copyright+     notice, this list of conditions and the following disclaimer.+  2. Redistributions in binary form must reproduce the above copyright+     notice, this list of conditions and the following disclaimer in the+     documentation and/or other materials provided with the distribution.+  3. Neither the name of the author nor the names of other contributors+     may be used to endorse or promote products derived from this software+     without specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND+  ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+  ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+  SUCH DAMAGE.++syb LICENSE file:++  This library (libraries/syb) is derived from code from several
+  sources: 
+  
+    * Code from the GHC project which is largely (c) The University of
+      Glasgow, and distributable under a BSD-style license (see below),
+  
+    * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
+      and freely redistributable (but see the full license for
+      restrictions).
+  
+    * Code from the Haskell Foreign Function Interface specification,
+      which is (c) Manuel M. T. Chakravarty and freely redistributable
+      (but see the full license for restrictions).
+  
+  The full text of these licenses is reproduced below.  All of the
+  licenses are BSD-style or compatible.
+  
+  -----------------------------------------------------------------------------
+  
+  The Glasgow Haskell Compiler License
+  
+  Copyright 2004, The University Court of the University of Glasgow. 
+  All rights reserved.
+  
+  Redistribution and use in source and binary forms, with or without
+  modification, are permitted provided that the following conditions are met:
+  
+  - Redistributions of source code must retain the above copyright notice,
+  this list of conditions and the following disclaimer.
+   
+  - Redistributions in binary form must reproduce the above copyright notice,
+  this list of conditions and the following disclaimer in the documentation
+  and/or other materials provided with the distribution.
+   
+  - Neither name of the University nor the names of its contributors may be
+  used to endorse or promote products derived from this software without
+  specific prior written permission. 
+  
+  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
+  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
+  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
+  DAMAGE.
+  
+  -----------------------------------------------------------------------------
+  
+  Code derived from the document "Report on the Programming Language
+  Haskell 98", is distributed under the following license:
+  
+    Copyright (c) 2002 Simon Peyton Jones
+  
+    The authors intend this Report to belong to the entire Haskell
+    community, and so we grant permission to copy and distribute it for
+    any purpose, provided that it is reproduced in its entirety,
+    including this Notice.  Modified versions of this Report may also be
+    copied and distributed for any purpose, provided that the modified
+    version is clearly presented as such, and that it does not claim to
+    be a definition of the Haskell 98 Language.
+  
+  -----------------------------------------------------------------------------
+  
+  Code derived from the document "The Haskell 98 Foreign Function
+  Interface, An Addendum to the Haskell 98 Report" is distributed under
+  the following license:
+  
+    Copyright (c) 2002 Manuel M. T. Chakravarty
+  
+    The authors intend this Report to belong to the entire Haskell
+    community, and so we grant permission to copy and distribute it for
+    any purpose, provided that it is reproduced in its entirety,
+    including this Notice.  Modified versions of this Report may also be
+    copied and distributed for any purpose, provided that the modified
+    version is clearly presented as such, and that it does not claim to
+    be a definition of the Haskell 98 Foreign Function Interface.
+  
+  -----------------------------------------------------------------------------
++template-haskell LICENSE file:++  +  The Glasgow Haskell Compiler License+  +  Copyright 2002-2007, The University Court of the University of Glasgow.+  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +  - Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.+  +  - Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.+  +  - Neither name of the University nor the names of its contributors may be+  used to endorse or promote products derived from this software without+  specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+  DAMAGE.+  ++terminfo LICENSE file:++  Copyright 2007, Judah Jacobson.+  All Rights Reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +  - Redistribution of source code must retain the above copyright notice,+  this list of conditions and the following disclamer.+  +  - Redistribution in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclamer in the documentation+  and/or other materials provided with the distribution.+  +  THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS "AS IS" AND ANY+  EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+  WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+  DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR THE CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+  SERVICES; LOSS OF USE, DATA OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE+  USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++text LICENSE file:++  Copyright (c) 2008-2009, Tom Harper+  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions+  are met:+  +      * Redistributions of source code must retain the above copyright+        notice, this list of conditions and the following disclaimer.+  +      * Redistributions in binary form must reproduce the above+        copyright notice, this list of conditions and the following+        disclaimer in the documentation and/or other materials provided+        with the distribution.+  +  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++time LICENSE file:++  TimeLib is Copyright (c) Ashley Yakeley, 2004-2014. All rights reserved.+  Certain sections are Copyright 2004, The University Court of the University of Glasgow. All rights reserved.+  +  Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:+  +  - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.+  +  - Neither name of the copyright holders nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++transformers LICENSE file:++  The Glasgow Haskell Compiler License+  +  Copyright 2004, The University Court of the University of Glasgow.+  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +  - Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.+  +  - Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.+  +  - Neither name of the University nor the names of its contributors may be+  used to endorse or promote products derived from this software without+  specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+  DAMAGE.++transformers-compat LICENSE file:++  Copyright 2012 Edward Kmett+  +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions+  are met:+  +  1. Redistributions of source code must retain the above copyright+     notice, this list of conditions and the following disclaimer.+  +  2. Redistributions in binary form must reproduce the above copyright+     notice, this list of conditions and the following disclaimer in the+     documentation and/or other materials provided with the distribution.+  +  3. Neither the name of the author nor the names of his contributors+     may be used to endorse or promote products derived from this software+     without specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR+  IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+  WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+  DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+  ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+  STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+  ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+  POSSIBILITY OF SUCH DAMAGE.++unix LICENSE file:++  The Glasgow Haskell Compiler License+  +  Copyright 2004, The University Court of the University of Glasgow. +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +  - Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.+   +  - Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.+   +  - Neither name of the University nor the names of its contributors may be+  used to endorse or promote products derived from this software without+  specific prior written permission. +  +  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+  DAMAGE.++unordered-containers LICENSE file:++  Copyright (c) 2010, Johan Tibell+  +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +      * Redistributions of source code must retain the above copyright+        notice, this list of conditions and the following disclaimer.+  +      * Redistributions in binary form must reproduce the above+        copyright notice, this list of conditions and the following+        disclaimer in the documentation and/or other materials provided+        with the distribution.+  +      * Neither the name of Johan Tibell nor the names of other+        contributors may be used to endorse or promote products derived+        from this software without specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++utf8-string LICENSE file:++  * Copyright (c) 2007, Galois Inc.+  * All rights reserved.+  *+  * Redistribution and use in source and binary forms, with or without+  * modification, are permitted provided that the following conditions are met:+  *     * Redistributions of source code must retain the above copyright+  *       notice, this list of conditions and the following disclaimer.+  *     * Redistributions in binary form must reproduce the above copyright+  *       notice, this list of conditions and the following disclaimer in the+  *       documentation and/or other materials provided with the distribution.+  *     * Neither the name of Galois Inc. nor the+  *       names of its contributors may be used to endorse or promote products+  *       derived from this software without specific prior written permission.+  *+  * THIS SOFTWARE IS PROVIDED BY Galois Inc. ``AS IS'' AND ANY+  * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+  * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+  * DISCLAIMED. IN NO EVENT SHALL Galois Inc. BE LIABLE FOR ANY+  * DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+  * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+  * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+  * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+  * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+  * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++vector LICENSE file:++  Copyright (c) 2008-2012, Roman Leshchinskiy+  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions are met:+  +  - Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.+   +  - Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.+   +  - Neither name of the University nor the names of its contributors may be+  used to endorse or promote products derived from this software without+  specific prior written permission. +  +  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+  DAMAGE.+  ++void LICENSE file:++  Copyright 2013 Edward Kmett+  +  All rights reserved.+  +  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions+  are met:+  +  1. Redistributions of source code must retain the above copyright+     notice, this list of conditions and the following disclaimer.+  +  2. Redistributions in binary form must reproduce the above copyright+     notice, this list of conditions and the following disclaimer in the+     documentation and/or other materials provided with the distribution.+  +  3. Neither the name of the author nor the names of his contributors+     may be used to endorse or promote products derived from this software+     without specific prior written permission.+  +  THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR+  IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+  WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+  DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+  ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+  STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+  ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+  POSSIBILITY OF SUCH DAMAGE.+

+ examples/failing/365.purs view

@@ -0,0 +1,13 @@+module Main where++import Prelude++class C a where+  f :: a -> a+  g :: a -> a++instance cS :: C String where+  f s = s+  g = f++main = g "Done"

+ examples/failing/438.purs view

@@ -0,0 +1,11 @@+module Main where++import Prelude++data Fix f = In (f (Fix f))++instance eqFix :: (Eq (f (Fix f))) => Eq (Fix f) where+  (==) (In f) (In g) = f == g+  (/=) a b = not (a == b)++example = In [] == In []

examples/failing/ArrayType.purs view

@@ -1,5 +1,6 @@ module Main where +import Prelude import Debug.Trace  bar :: Number -> Number -> Number

examples/failing/Arrays.purs view

@@ -1,5 +1,5 @@ module Main where -  import Prelude+import Prelude -  test = \arr -> arr !! (0 !! 0)+test = \arr -> arr !! (0 !! 0)

+ examples/failing/CaseDoesNotMatchAllConstructorArgs.purs view

@@ -0,0 +1,14 @@+module Main where++import Prelude++data Person = Person String Int++data TwoPeople = Two Person Person++getName p = case p of+  (Two (Person n) (Person n2 a2)) -> n+  _ -> "Unknown"+++name = getName (Two (Person "Jimmy" 20) (Person "" 1))

examples/failing/Do.purs view

@@ -1,5 +1,7 @@ module Main where +import Prelude+ test1 = do let x = 1  test2 y = do x <- y

examples/failing/DuplicateDeclarationsInLet.purs view

@@ -1,5 +1,7 @@ module Main where +import Prelude+ foo = a   where   a :: Number

examples/failing/DuplicateProperties1.purs view

@@ -1,9 +1,11 @@ module DuplicateProperties where +import Prelude+ foreign import data Test :: # * -> * -foreign import subtractX "" :: forall r. Test (x :: Unit | r) -> Test r+foreign import subtractX :: forall r. Test (x :: Unit | r) -> Test r -foreign import hasX "" :: Test (x :: Unit, y :: Unit)+foreign import hasX :: Test (x :: Unit, y :: Unit)  baz = subtractX (subtractX hasX)

examples/failing/DuplicateProperties2.purs view

@@ -1,9 +1,11 @@ module DuplicateProperties where +import Prelude+ foreign import data Test :: # * -> * -foreign import subtractX "" :: forall r. Test (x :: Unit | r) -> Test r+foreign import subtractX :: forall r. Test (x :: Unit | r) -> Test r -foreign import hasX "" :: forall r. Test (x :: Unit, y :: Unit | r)+foreign import hasX :: forall r. Test (x :: Unit, y :: Unit | r)  baz = subtractX (subtractX hasX)

examples/failing/DuplicateTypeVars.purs view

@@ -1,3 +1,5 @@ module Main where +import Prelude+ type Foo a a = a

examples/failing/Foldable.purs view

@@ -1,12 +1,16 @@ module Main where +import Prelude+ class Foldable f where   fold :: forall a b. (a -> b -> b) -> b -> f a -> b   size :: forall a. f a -> Number -instance foldableArray :: Foldable [] where-  fold _ z [] = z-  fold f z (x:xs) = x `f` (fold f z xs)-  size = fold (const ((+) 1)) 0+data L a = C a (L a) | N -x = size [1,2,3]+instance foldableL :: Foldable L where+  fold _ z N = z+  fold f z (C x xs) = x `f` (fold f z xs)+  size = fold (const ((+) 1.0)) 0.0++x = size (C 1 (C 2 (C 3 N)))

examples/failing/InstanceExport.purs view

@@ -1,5 +1,7 @@ module InstanceExport (S(..), f) where +import Prelude+ newtype S = S String  class F a where

examples/failing/KindError.purs view

@@ -1,3 +1,5 @@ module Main where -  data KindError f a = One f | Two (f a)+import Prelude++data KindError f a = One f | Two (f a)

+ examples/failing/LeadingZeros1.purs view

@@ -0,0 +1,5 @@+module Main where++import Prelude++x = 01

+ examples/failing/LeadingZeros2.purs view

@@ -0,0 +1,5 @@+module Main where++import Prelude++x = 00.1

examples/failing/Let.purs view

@@ -1,3 +1,5 @@ module Main where +import Prelude+ test = let x = x in x

examples/failing/MPTCs.purs view

@@ -1,5 +1,7 @@ module Main where +import Prelude+ class Foo a where   f :: a -> a

examples/failing/MissingClassExport.purs view

@@ -1,4 +1,6 @@ module Test (bar) where -  class Foo a where-    bar :: a -> a+import Prelude++class Foo a where+  bar :: a -> a

examples/failing/MissingClassMemberExport.purs view

@@ -1,4 +1,6 @@ module Test (Foo) where -  class Foo a where-    bar :: a -> a+import Prelude++class Foo a where+  bar :: a -> a

examples/failing/MultipleErrors.purs view

@@ -1,5 +1,7 @@ module MultipleErrors where +import Prelude+ foo :: Number -> Number foo 0 = "Test" foo n = bar (n - 1)

examples/failing/MultipleErrors2.purs view

@@ -1,5 +1,7 @@ module MultipleErrors2 where +import Prelude+ foo = itDoesntExist  bar = neitherDoesThis

examples/failing/MutRec.purs view

@@ -1,5 +1,7 @@ module MutRec where +import Prelude+ x = y  y = x

examples/failing/MutRec2.purs view

@@ -1,3 +1,5 @@ module Main where +import Prelude+ x = x

examples/failing/NewtypeMultiArgs.purs view

@@ -1,3 +1,5 @@ module Main where +import Prelude+ newtype Thing = Thing String Boolean

examples/failing/NewtypeMultiCtor.purs view

@@ -1,3 +1,5 @@ module Main where +import Prelude+ newtype Thing = Thing String | Other

examples/failing/NoOverlap.purs view

@@ -1,5 +1,7 @@ module Main where +import Prelude+ data Foo = Foo  instance showFoo1 :: Show Foo where

examples/failing/NullaryAbs.purs view

@@ -1,3 +1,5 @@ module Main where -  func = \ -> "no"+import Prelude++func = \ -> "no"

examples/failing/Object.purs view

@@ -1,5 +1,7 @@ module Main where +import Prelude+ test o = o.foo  test1 = test {}

examples/failing/OverlappingArguments.purs view

@@ -1,3 +1,5 @@ module OverlappingArguments where +import Prelude+ f x x = x

examples/failing/OverlappingBinders.purs view

@@ -1,4 +1,8 @@ module OverlappingBinders where +import Prelude++data S a = S a (S a)+ f x = case x of-  (y:y@(z:zs)) -> y+  (S y (S y@(S z zs))) -> y

examples/failing/OverlappingInstances.purs view

@@ -1,5 +1,7 @@ module OverlappingInstances where +import Prelude+ data A = A  instance showA1 :: Show A where

examples/failing/OverlappingInstances2.purs view

@@ -1,5 +1,7 @@ module OverlappingInstances where +import Prelude+ data A = A | B  instance eqA1 :: Eq A where

examples/failing/OverlappingVars.purs view

@@ -1,5 +1,7 @@ module Main where +import Prelude+ class OverlappingVars a where   f :: a -> a

examples/failing/Rank2Types.purs view

@@ -1,7 +1,7 @@ module Main where -  import Prelude+import Prelude -  foreign import test :: (forall a. a -> a) -> Number+foreign import test :: (forall a. a -> a) -> Number -  test1 = test (\n -> n + 1)+test1 = test (\n -> n + 1)

examples/failing/Reserved.purs view

@@ -1,4 +1,6 @@ module Main where +import Prelude+ (<) :: Number -> Number -> Number (<) a b = !(a >= b)

+ examples/failing/RowConstructors1.purs view

@@ -0,0 +1,8 @@+module Main where++import Prelude++data Foo = Bar+type Baz = { | Foo }++main = Debug.Trace.trace "Done"

+ examples/failing/RowConstructors2.purs view

@@ -0,0 +1,8 @@+module Main where++import Prelude++type Foo r = (x :: Number | r)+type Bar = { | Foo }++main = Debug.Trace.trace "Done"

+ examples/failing/RowConstructors3.purs view

@@ -0,0 +1,8 @@+module Main where++import Prelude++type Foo = { x :: Number }+type Bar = { | Foo }++main = Debug.Trace.trace "Done"

examples/failing/SkolemEscape.purs view

@@ -1,5 +1,7 @@ module Main where -  foreign import foo :: (forall a. a -> a) -> Number+import Prelude -  test = \x -> foo x+foreign import foo :: (forall a. a -> a) -> Number++test = \x -> foo x

examples/failing/Superclasses1.purs view

@@ -1,5 +1,7 @@ module Main where +import Prelude+ class Su a where   su :: a -> a

examples/failing/Superclasses2.purs view

@@ -1,5 +1,7 @@ module CycleInSuperclasses where +import Prelude+ class (Foo a) <= Bar a  class (Bar a) <= Foo a

examples/failing/Superclasses3.purs view

@@ -1,5 +1,7 @@ module UnknownSuperclassTypeVar where +import Prelude+ class Foo a  class (Foo b) <= Bar a

examples/failing/Superclasses4.purs view

@@ -1,5 +1,7 @@ module OverlappingInstances where +import Prelude+ class Foo a  instance foo1 :: Foo Number

examples/failing/TopLevelCaseNoArgs.purs view

@@ -1,4 +1,7 @@ module Main where-  foo :: Number-  foo = 1-  foo = 2++import Prelude++foo :: Number+foo = 1+foo = 2

examples/failing/TypeClassInstances.purs view

@@ -1,5 +1,7 @@ module Main where +import Prelude+ class A a where   a :: a -> String   b :: a -> Number

examples/failing/TypeError.purs view

@@ -1,5 +1,5 @@ module Main where -  import Prelude+import Prelude -  test = 1 ++ "A"+test = 1 ++ "A"

examples/failing/TypeSynonyms.purs view

@@ -1,5 +1,7 @@ module Main where -type T1 = [T2]+import Prelude++type T1 = Array T2  type T2 = T1

examples/failing/TypeSynonyms2.purs view

@@ -1,5 +1,7 @@ module Main where +import Prelude+ class Foo a where   foo :: a -> String

examples/failing/TypeSynonyms3.purs view

@@ -1,5 +1,7 @@ module Main where +import Prelude+ class Foo a where   foo :: a -> String

examples/failing/TypeSynonyms4.purs view

@@ -1,5 +1,7 @@ module TypeSynonyms4 where +import Prelude+ type F x y = x -> y  type G x = F x

+ examples/failing/TypeSynonyms5.purs view

@@ -0,0 +1,5 @@+module Main where++import Prelude++type T = T

examples/failing/TypeWildcards1.purs view

@@ -1,4 +1,6 @@ module TypeWildcards where +import Prelude+ type Test = _

examples/failing/TypeWildcards2.purs view

@@ -1,4 +1,6 @@ module TypeWildcards where +import Prelude+ data Test = Test _

examples/failing/TypeWildcards3.purs view

@@ -1,5 +1,7 @@ module TypeWildcards where +import Prelude+ data Foo a = Foo  instance showFoo :: Show (Foo _) where

examples/failing/UnderscoreModuleName.purs view

@@ -1,3 +1,5 @@ module Bad_Module where +import Prelude+ main = Debug.Trace.trace "Done"

examples/failing/UnifyInTypeInstanceLookup.purs view

@@ -1,5 +1,7 @@ module Main where +import Prelude+ data Z = Z data S n = S n

examples/failing/UnknownType.purs view

@@ -1,4 +1,6 @@ module Main where +import Prelude+ test :: Number -> Something test = {}

examples/passing/652.purs view

@@ -1,5 +1,7 @@ module Main where +import Prelude+ class Foo a b  class Bar a c

examples/passing/810.purs view

@@ -1,5 +1,7 @@ module Main where +import Prelude+ data Maybe a = Nothing | Just a  test :: forall a. Maybe a -> Maybe a

examples/passing/ArrayType.purs view

@@ -1,9 +1,11 @@ module Main where +import Prelude+ class Pointed p where   point :: forall a. a -> p a -instance pointedArray :: Pointed [] where+instance pointedArray :: Pointed Array where   point a = [a]  main = Debug.Trace.trace "Done"

− examples/passing/Arrays.purs

@@ -1,24 +0,0 @@-module Main where--import Prelude.Unsafe (unsafeIndex)--test1 arr = arr `unsafeIndex` 0 + arr `unsafeIndex` 1 + 1--test2 = \arr -> case arr of-  [x, y] -> x + y-  [x] -> x-  [] -> 0-  (x : y : _) -> x + y--data Tree = One Number | Some [Tree]--test3 = \tree sum -> case tree of-  One n -> n-  Some (n1 : n2 : rest) -> test3 n1 sum * 10 + test3 n2 sum * 5 + sum rest--test4 = \arr -> case arr of-  [] -> 0-  [_] -> 0-  x : y : xs -> x * y + test4 xs--main = Debug.Trace.trace "Done"

examples/passing/Auto.purs view

@@ -1,13 +1,15 @@ module Main where -  data Auto s i o = Auto { state :: s, step :: s -> i -> o }+import Prelude -  type SomeAuto i o = forall r. (forall s. Auto s i o -> r) -> r+data Auto s i o = Auto { state :: s, step :: s -> i -> o } -  exists :: forall s i o. s -> (s -> i -> o) -> SomeAuto i o-  exists = \state step f -> f (Auto { state: state, step: step })+type SomeAuto i o = forall r. (forall s. Auto s i o -> r) -> r -  run :: forall i o. SomeAuto i o -> i -> o-  run = \s i -> s (\a -> case a of Auto a -> a.step a.state i)+exists :: forall s i o. s -> (s -> i -> o) -> SomeAuto i o+exists = \state step f -> f (Auto { state: state, step: step }) -  main = Debug.Trace.trace "Done"+run :: forall i o. SomeAuto i o -> i -> o+run = \s i -> s (\a -> case a of Auto a -> a.step a.state i)++main = Debug.Trace.trace "Done"

examples/passing/AutoPrelude.purs view

@@ -1,8 +1,9 @@ module Main where +import Prelude import Debug.Trace -f x = x * 10-g y = y - 10+f x = x * 10.0+g y = y - 10.0 -main = trace $ show $ (f <<< g) 100+main = trace $ show $ (f <<< g) 100.0

examples/passing/AutoPrelude2.purs view

@@ -1,5 +1,6 @@ module Main where +import Prelude import qualified Prelude as P import Debug.Trace

examples/passing/BindersInFunctions.purs view

@@ -1,18 +1,12 @@ module Main where  import Prelude--tail = \(_:xs) -> xs+import Assert -foreign import error-  """-  function error(msg) {-    throw msg;-  }-  """ :: forall a. String -> a+snd = \[_, y] -> y  main =-  let ts = tail [1, 2, 3] in-  if ts == [2, 3]+  let ts = snd [1.0, 2.0] in+  if ts == 2.0   then Debug.Trace.trace "Done"-  else error "Incorrect result from 'tails'."+  else error "Incorrect result from 'snd'."

examples/passing/BindingGroups.purs view

@@ -1,8 +1,10 @@ module Main where +import Prelude+ foo = bar-  where bar r = r + 1+  where bar r = r + 1.0 -r = foo 2+r = foo 2.0  main = Debug.Trace.trace "Done"

examples/passing/BlockString.purs view

@@ -1,12 +1,8 @@ module Main where -foreign import foo """-  function foo(s) {-    return s;-  }-""" :: String -> String+import Prelude -bar :: String -> String-bar _ = foo "test"+foo :: String+foo = """foo"""  main = Debug.Trace.trace "Done"

examples/passing/CaseInDo.purs view

@@ -1,20 +1,19 @@ module Main where +import Prelude import Debug.Trace import Control.Monad.Eff -foreign import doIt "function doIt() { global.flag = true; }" :: forall eff. Eff eff Unit--foreign import get "function get() { return global.flag; }" :: forall eff. Eff eff Boolean+doIt :: forall eff. Eff eff Boolean+doIt = return true  set = do   trace "Testing..."   case 0 of     0 -> doIt-    _ -> return unit+    _ -> return false  main = do-  set-  b <- get+  b <- set   case b of     true -> trace "Done"

examples/passing/CaseStatement.purs view

@@ -1,5 +1,7 @@ module Main where +import Prelude+ data A = A | B | C  f a _ A = a

examples/passing/CheckFunction.purs view

@@ -1,5 +1,7 @@ module Main where -test = ((\x -> x+1) >>> (\x -> x*2)) 4+import Prelude++test = ((\x -> x+1.0) >>> (\x -> x*2.0)) 4.0  main = Debug.Trace.trace "Done"

examples/passing/CheckSynonymBug.purs view

@@ -1,16 +1,9 @@ module Main where -  import Prelude--  type Foo a = [a]+import Prelude -  foreign import length-    """-    function length(a) {-      return a.length;-    }-    """ :: forall a. [a] -> Number+type Foo a = Array a -  foo _ = length ([] :: Foo Number)+foo _ = length ([] :: Foo Number) -  main = Debug.Trace.trace "Done"+main = Debug.Trace.trace "Done"

examples/passing/CheckTypeClass.purs view

@@ -1,16 +1,18 @@ module Main where -  data Bar a = Bar-  data Baz+import Prelude -  class Foo a where-    foo :: Bar a -> Baz+data Bar a = Bar+data Baz -  foo_ :: forall a. (Foo a) => a -> Baz-  foo_ x = foo ((mkBar :: forall a. (Foo a) => a -> Bar a) x)+class Foo a where+  foo :: Bar a -> Baz -  mkBar :: forall a. a -> Bar a-  mkBar _ = Bar+foo_ :: forall a. (Foo a) => a -> Baz+foo_ x = foo ((mkBar :: forall a. (Foo a) => a -> Bar a) x) -  main = Debug.Trace.trace "Done"+mkBar :: forall a. a -> Bar a+mkBar _ = Bar++main = Debug.Trace.trace "Done"

examples/passing/Church.purs view

@@ -1,18 +1,18 @@ module Main where -  import Prelude ()+import Prelude () -  type List a = forall r. r -> (a -> r -> r) -> r+type List a = forall r. r -> (a -> r -> r) -> r -  empty :: forall a. List a-  empty = \r f -> r+empty :: forall a. List a+empty = \r f -> r -  cons :: forall a. a -> List a -> List a-  cons = \a l r f -> f a (l r f)+cons :: forall a. a -> List a -> List a+cons = \a l r f -> f a (l r f) -  append :: forall a. List a -> List a -> List a-  append = \l1 l2 r f -> l2 (l1 r f) f+append :: forall a. List a -> List a -> List a+append = \l1 l2 r f -> l2 (l1 r f) f -  test = append (cons 1 empty) (cons 2 empty)+test = append (cons 1 empty) (cons 2 empty) -  main = Debug.Trace.trace "Done"+main = Debug.Trace.trace "Done"

examples/passing/Collatz.purs view

@@ -7,12 +7,12 @@ collatz :: Number -> Number collatz n = runPure (runST (do   r <- newSTRef n-  count <- newSTRef 0+  count <- newSTRef 0.0   untilE $ do-    modifySTRef count $ (+) 1+    modifySTRef count $ (+) 1.0     m <- readSTRef r-    writeSTRef r $ if m % 2 == 0 then m / 2 else 3 * m + 1-    return $ m == 1+    writeSTRef r $ if m % 2.0 == 0.0 then m / 2.0 else 3.0 * m + 1.0+    return $ m == 1.0   readSTRef count)) -main = Debug.Trace.print $ collatz 1000+main = Debug.Trace.print $ collatz 1000.0

examples/passing/Comparisons.purs view

@@ -1,24 +1,14 @@ module Main where +import Prelude import Control.Monad.Eff import Debug.Trace--foreign import data Assert :: !--foreign import assert-  """-  function assert(x) {-    return function() {-      if (!x) throw new Error('assertion failed');-      return {};-    };-  }-  """ :: forall e. Boolean -> Eff (assert :: Assert | e) Unit+import Assert  main = do-  assert (1 < 2)-  assert (2 == 2)-  assert (3 > 1)+  assert (1.0 < 2.0)+  assert (2.0 == 2.0)+  assert (3.0 > 1.0)   assert ("a" < "b")   assert ("a" == "a")   assert ("z" > "a")

examples/passing/Conditional.purs view

@@ -1,9 +1,9 @@ module Main where -  import Prelude ()+import Prelude () -  fns = \f -> if f true then f else \x -> x+fns = \f -> if f true then f else \x -> x -  not = \x -> if x then false else true+not = \x -> if x then false else true -  main = Debug.Trace.trace "Done"+main = Debug.Trace.trace "Done"

examples/passing/Console.purs view

@@ -5,9 +5,9 @@ import Debug.Trace  replicateM_ :: forall m a. (Monad m) => Number -> m a -> m {}-replicateM_ 0 _ = return {}+replicateM_ 0.0 _ = return {} replicateM_ n act = do   act-  replicateM_ (n - 1) act+  replicateM_ (n - 1.0) act -main = replicateM_ 10 (trace "Hello World!")+main = replicateM_ 10.0 (trace "Hello World!")

examples/passing/DataAndType.purs view

@@ -1,5 +1,7 @@ module Main where +import Prelude+ data A = A B  type B = A

examples/passing/DeepArrayBinder.purs view

@@ -1,18 +1,15 @@ module Main where +import Prelude import Control.Monad.Eff+import Assert -match2 :: [Number] -> Number-match2 (x : y : xs) = x * y + match2 xs-match2 _ = 0+data List a = Cons a (List a) | Nil -foreign import explode-  """-  function explode() {-    throw new Error('Incorrect result');-  }-  """ :: forall eff a. Eff eff a+match2 :: List Number -> Number+match2 (Cons x (Cons y xs)) = x * y + match2 xs+match2 _ = 0.0 -main = case match2 [1, 2, 3, 4, 5, 6, 7, 8, 9] of-  100 -> Debug.Trace.trace "Done"-  _ -> explode+main = case match2 (Cons 1.0 (Cons 2.0 (Cons 3.0 (Cons 4.0 (Cons 5.0 (Cons 6.0 (Cons 7.0 (Cons 8.0 (Cons 9.0 Nil))))))))) of+  100.0 -> Debug.Trace.trace "Done"+  _ -> error "Incorrect result!"

examples/passing/DeepCase.purs view

@@ -1,5 +1,6 @@ module Main where +import Prelude import Debug.Trace import Control.Monad.Eff import Control.Monad.ST@@ -7,8 +8,8 @@ f x y =   let     g = case y of-	  0 -> x-          x -> 1 + x * x+	  0.0 -> x+          x -> 1.0 + x * x   in g + x + y -main = print $ f 1 10+main = print $ f 1.0 10.0

examples/passing/Do.purs view

@@ -16,8 +16,8 @@   pure = Just  instance bindMaybe :: Bind Maybe where-  (>>=) Nothing _ = Nothing-  (>>=) (Just a) f = f a+  bind Nothing _ = Nothing+  bind (Just a) f = f a  instance monadMaybe :: Prelude.Monad Maybe @@ -25,26 +25,26 @@   Just "abc"  test2 = \_ -> do-  (x : _) <- Just [1, 2, 3]-  (y : _) <- Just [4, 5, 6]+  x <- Just 1.0+  y <- Just 2.0   Just (x + y)  test3 = \_ -> do-  Just 1+  Just 1.0   Nothing :: Maybe Number-  Just 2+  Just 2.0  test4 mx my = do   x <- mx   y <- my-  Just (x + y + 1)+  Just (x + y + 1.0)  test5 mx my mz = do   x <- mx   y <- my   let sum = x + y   z <- mz-  Just (z + sum + 1)+  Just (z + sum + 1.0)  test6 mx = \_ -> do   let@@ -54,14 +54,14 @@  test8 = \_ -> do   Just (do-    Just 1)+    Just 1.0) -test9 = \_ -> (+) <$> Just 1 <*> Just 2+test9 = \_ -> (+) <$> Just 1.0 <*> Just 2.0  test10 _ = do   let-    f x = g x * 3-    g x = f x / 2-  Just (f 10)+    f x = g x * 3.0+    g x = f x / 2.0+  Just (f 10.0)  main = Debug.Trace.trace "Done"

examples/passing/Eff.purs view

@@ -10,13 +10,13 @@   trace "Line 2"  test2 = runPure (runST (do-          ref <- newSTRef 0-          modifySTRef ref $ \n -> n + 1+          ref <- newSTRef 0.0+          modifySTRef ref $ \n -> n + 1.0           readSTRef ref))  test3 = pureST (do-          ref <- newSTRef 0-          modifySTRef ref $ \n -> n + 1+          ref <- newSTRef 0.0+          modifySTRef ref $ \n -> n + 1.0           readSTRef ref)  main = do

examples/passing/EmptyDataDecls.purs view

@@ -1,33 +1,18 @@ module Main where  import Prelude+import Assert  data Z data S n -data ArrayBox n a = ArrayBox [a]+data ArrayBox n a = ArrayBox (Array a)  nil :: forall a. ArrayBox Z a nil = ArrayBox [] -foreign import concat-  """-  function concat(l1) {-    return function(l2) {-      return l1.concat(l2);-    };-  }-  """ :: forall a. [a] -> [a] -> [a]- cons' :: forall a n. a -> ArrayBox n a -> ArrayBox (S n) a cons' x (ArrayBox xs) = ArrayBox $ concat [x] xs--foreign import error-  """-  function error(msg) {-    throw msg;-  }-  """ :: forall a. String -> a  main = case cons' 1 $ cons' 2 $ cons' 3 nil of          ArrayBox [1, 2, 3] -> Debug.Trace.trace "Done"

examples/passing/EmptyRow.purs view

@@ -1,5 +1,7 @@ module Main where +import Prelude+ data Foo r = Foo { | r }  test :: Foo ()

examples/passing/EmptyTypeClass.purs view

@@ -4,8 +4,8 @@  class Partial -head :: forall a. (Partial) => [a] -> a-head (x:xs) = x+head :: forall a. (Partial) => Array a -> a+head [x] = x  instance allowPartials :: Partial

examples/passing/EqOrd.purs view

@@ -1,5 +1,7 @@ module Main where +import Prelude+ data Pair a b = Pair a b  instance ordPair :: (Ord a, Ord b) => Ord (Pair a b) where@@ -11,4 +13,4 @@   (==) (Pair a1 b1) (Pair a2 b2) = a1 == a2 && b1 == b2   (/=) (Pair a1 b1) (Pair a2 b2) = a1 /= a2 || b1 /= b2 -main = Debug.Trace.print $ Pair 1 2 == Pair 1 2+main = Debug.Trace.print $ Pair 1.0 2.0 == Pair 1.0 2.0

examples/passing/ExtendedInfixOperators.purs view

@@ -1,20 +1,14 @@ module Main where -zipWith :: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]-zipWith _ [] _  = []-zipWith _ _  [] = []-zipWith f (x:xs) (y:ys) = f x y : zipWith f xs ys--test1 = [1, 2, 3] `zipWith (+)` [4, 5, 6]+import Prelude  comparing :: forall a b. (Ord b) => (a -> b) -> a -> a -> Ordering comparing f = compare `Data.Function.on` f -sum [] = 0-sum (x:xs) = x + sum xs+null [] = true+null _ = false -test2 = [1, 2, 3] `comparing sum` [4, 5, 6]+test = [1.0, 2.0, 3.0] `comparing null` [4.0, 5.0, 6.0]  main = do-  Debug.Trace.print test1-  Debug.Trace.print test2+  Debug.Trace.print test

− examples/passing/ExternData.purs

@@ -1,13 +0,0 @@-module Main where--  foreign import data IO :: * -> *--  foreign import bind "function bind() {}" :: forall a b. IO a -> (a -> IO b) -> IO b--  foreign import showMessage "function showMessage() {}" :: String -> IO { }--  foreign import prompt "function prompt() {}" :: IO String--  test _ = prompt `bind` \s -> showMessage s--  main = Debug.Trace.trace "Done"

− examples/passing/ExternRaw.purs

@@ -1,26 +0,0 @@-module Main where--foreign import first-  """-  function first(xs) {-    return xs[0];-  }-  """ :: forall a. [a] -> a--foreign import loop-  """-  function loop() {-    while (true) {}-  }-  """ :: forall a. a--foreign import concat-  """-  function concat(xs) {-    return function(ys) {-      return xs.concat(ys);-    };-  }-  """ :: forall a. [a] -> [a] -> [a]--main = Debug.Trace.trace "Done"

− examples/passing/FFI.purs

@@ -1,13 +0,0 @@-module Main where--foreign import foo-  """-  function foo(s) {-    return s;-  }-  """ :: String -> String--bar :: String -> String-bar _ = foo "test"--main = Debug.Trace.trace "Done"

examples/passing/Fib.purs view

@@ -5,9 +5,9 @@ import Control.Monad.ST  main = runST (do-  n1 <- newSTRef 1-  n2 <- newSTRef 1-  whileE ((>) 1000 <$> readSTRef n1) $ do+  n1 <- newSTRef 1.0+  n2 <- newSTRef 1.0+  whileE ((>) 1000.0 <$> readSTRef n1) $ do     n1' <- readSTRef n1     n2' <- readSTRef n2     writeSTRef n2 $ n1' + n2'

examples/passing/FinalTagless.purs view

@@ -17,6 +17,6 @@ runId (Id a) = a  three :: Expr Number-three = add (num 1) (num 2)+three = add (num 1.0) (num 2.0)  main = Debug.Trace.print $ runId three

− examples/passing/ForeignInstance.purs

@@ -1,20 +0,0 @@-module Main where--class Foo a where-  foo :: a -> String--foreign import instance fooArray :: (Foo a) => Foo [a]--foreign import instance fooNumber :: Foo Number--foreign import instance fooString :: Foo String--foreign import fooString "var fooString = {};" :: Unit-foreign import fooNumber "var fooNumber = {};" :: Unit-foreign import fooArray "var fooArray = {};" :: Unit--test1 _ = foo [1, 2, 3]--test2 _ = foo "Test"--main = Debug.Trace.trace "Done"

examples/passing/FunctionScope.purs view

@@ -1,19 +1,13 @@ module Main where -  import Prelude--  mkValue :: Number -> Number-  mkValue id = id+import Prelude+import Assert -  foreign import error-    """-    function error(msg) {-      throw msg;-    }-    """ :: forall a. String -> a+mkValue :: Number -> Number+mkValue id = id -  main = do-    let value = mkValue 1-    if value == 1-      then Debug.Trace.trace "Done"-      else error "Not done"+main = do+  let value = mkValue 1.0+  if value == 1.0+    then Debug.Trace.trace "Done"+    else error "Not done"

examples/passing/Functions.purs view

@@ -1,15 +1,15 @@ module Main where -  import Prelude+import Prelude -  test1 = \_ -> 0+test1 = \_ -> 0.0 -  test2 = \a b -> a + b + 1+test2 = \a b -> a + b + 1.0 -  test3 = \a -> a+test3 = \a -> a -  test4 = \(%%) -> 1 %% 2+test4 = \(%%) -> 1.0 %% 2.0 -  test5 = \(+++) (***) -> 1 +++ 2 *** 3+test5 = \(+++) (***) -> 1.0 +++ 2.0 *** 3.0 -  main = Debug.Trace.trace "Done"+main = Debug.Trace.trace "Done"

examples/passing/Functions2.purs view

@@ -1,19 +1,13 @@ module Main where -  import Prelude--  test :: forall a b. a -> b -> a-  test = \const _ -> const+import Prelude+import Assert -  foreign import error-    """-    function error(msg) {-      throw msg;-    }-    """ :: forall a. String -> a+test :: forall a b. a -> b -> a+test = \const _ -> const -  main = do-    let value = test "Done" {}-    if value == "Done"-      then Debug.Trace.trace "Done"-      else error "Not done"+main = do+  let value = test "Done" {}+  if value == "Done"+    then Debug.Trace.trace "Done"+    else error "Not done"

examples/passing/Guards.purs view

@@ -1,29 +1,29 @@ module Main where -  import Prelude+import Prelude -  collatz = \x -> case x of-    y | y % 2 == 0 -> y / 2-    y -> y * 3 + 1+collatz = \x -> case x of+  y | y % 2.0 == 0.0 -> y / 2.0+  y -> y * 3.0 + 1.0 -  -- Guards have access to current scope-  collatz2 = \x y -> case x of-    z | y > 0 -> z / 2-    z -> z * 3 + 1+-- Guards have access to current scope+collatz2 = \x y -> case x of+  z | y > 0.0 -> z / 2.0+  z -> z * 3.0 + 1.0 -  min :: forall a. (Ord a) => a -> a -> a-  min n m | n < m     = n-          | otherwise = m+min :: forall a. (Ord a) => a -> a -> a+min n m | n < m     = n+        | otherwise = m -  max :: forall a. (Ord a) => a -> a -> a-  max n m = case unit of-    _ | m < n     -> n-      | otherwise -> m+max :: forall a. (Ord a) => a -> a -> a+max n m = case unit of+  _ | m < n     -> n+    | otherwise -> m -  testIndentation :: Number -> Number -> Number-  testIndentation x y | x > 0-    = x + y-                      | otherwise-    = y - x+testIndentation :: Number -> Number -> Number+testIndentation x y | x > 0.0+  = x + y+                    | otherwise+  = y - x -  main = Debug.Trace.trace $ min "Done" "ZZZZ"+main = Debug.Trace.trace $ min "Done" "ZZZZ"

examples/passing/HoistError.purs view

@@ -1,19 +1,12 @@ module Main where +import Prelude import Control.Monad.Eff import Debug.Trace--foreign import f-  """-  function f(x) {-    return function() {-      if (x !== 0) throw new Error('x is not 0');-    };-  }-  """ :: forall e. Number -> Eff e Number+import Assert  main = do-  let x = 0-  f x-  let x = 1 + 1+  let x = 0.0+  assert $ x == 0.0+  let x = 1.0 + 1.0   trace "Done"

examples/passing/IfThenElseMaybe.purs view

@@ -1,5 +1,7 @@ module Main where +import Prelude+ data Maybe a = Nothing | Just a  test1 = if true then Just 10 else Nothing

examples/passing/ImplicitEmptyImport.purs view

@@ -1,5 +1,7 @@ module Main where +import Prelude+ main = do   Debug.Trace.trace "Hello"   Debug.Trace.trace "Goodbye"

examples/passing/ImportHiding.purs view

@@ -7,7 +7,7 @@   Unit(..)  -- a constructor   ) -show = 1+show = 1.0  class Show a where   noshow :: a -> a

examples/passing/InferRecFunWithConstrainedArgument.purs view

@@ -2,7 +2,7 @@  import Prelude -test 100 = 100-test n = test(1 + n)+test 100.0 = 100.0+test n = test(1.0 + n) -main = Debug.Trace.print $ test 0+main = Debug.Trace.print $ test 0.0

examples/passing/InstanceBeforeClass.purs view

@@ -1,7 +1,9 @@ module Main where +import Prelude+ instance fooNumber :: Foo Number where-  foo = 0+  foo = 0.0  class Foo a where   foo :: a

+ examples/passing/IntAndChar.purs view

@@ -0,0 +1,18 @@+module Main where++import Prelude+import Control.Monad.Eff+import Assert++f 1 = 1+f _ = 0++g 'a' = 'a'+g _ = 'b'++main = do+  assert $ f 1 == 1+  assert $ f 0 == 0+  assert $ g 'a' == 'a'+  assert $ g 'b' == 'b'+  Debug.Trace.trace "Done"

examples/passing/JSReserved.purs view

@@ -1,12 +1,12 @@ module Main where -  import Prelude+import Prelude -  yield = 0-  member = 1+yield = 0+member = 1 -  public = \return -> return+public = \return -> return -  this catch = catch+this catch = catch -  main = Debug.Trace.trace "Done"+main = Debug.Trace.trace "Done"

examples/passing/KindedType.purs view

@@ -1,10 +1,12 @@ module Main where +import Prelude+ type Star2Star f = f :: * -> *  type Star t = t :: * -test1 :: Star2Star [] String+test1 :: Star2Star Array String test1 = ["test"]  f :: Star (String -> String)@@ -14,12 +16,12 @@  data Proxy (f :: * -> *) = Proxy -test3 :: Proxy []+test3 :: Proxy Array test3 = Proxy  type Test (f :: * -> *) = f String -test4 :: Test []+test4 :: Test Array test4 = ["test"]  class Clazz (a :: *) where

examples/passing/Let.purs view

@@ -6,59 +6,48 @@  test1 x = let             y :: Number-            y = x + 1+            y = x + 1.0           in y  test2 x y =-  let x' = x + 1 in-  let y' = y + 1 in+  let x' = x + 1.0 in+  let y' = y + 1.0 in   x' + y'  test3 = let f x y z = x + y + z in-        f 1 2 3+        f 1.0 2.0 3.0  test4 = let f x [y, z] = x y z in-        f (+) [1, 2]+        f (+) [1.0, 2.0]  test5 = let-          f x | x > 0 = g (x / 2) + 1-          f x = 0-          g x = f (x - 1) + 1-        in f 10--test6 = runPure (runST (do-          r <- newSTRef 0-          (let-            go [] = readSTRef r-            go (n : ns) = do-              modifySTRef r ((+) n)-              go ns-           in go [1, 2, 3, 4, 5])-        ))+          f x | x > 0.0 = g (x / 2.0) + 1.0+          f x = 0.0+          g x = f (x - 1.0) + 1.0+        in f 10.0  test7 = let           f :: forall a. a -> a           f x = x-        in if f true then f 1 else f 2+        in if f true then f 1.0 else f 2.0  test8 :: Number -> Number test8 x = let             go y | (x - 0.1 < y * y) && (y * y < x + 0.1) = y-            go y = go $ (y + x / y) / 2+            go y = go $ (y + x / y) / 2.0           in go x  test10 _ =   let-    f x = g x * 3-    g x = f x / 2-  in f 10+    f x = g x * 3.0+    g x = f x / 2.0+  in f 10.0  main = do-  Debug.Trace.print (test1 1)-  Debug.Trace.print (test2 1 2)+  Debug.Trace.print (test1 1.0)+  Debug.Trace.print (test2 1.0 2.0)   Debug.Trace.print test3   Debug.Trace.print test4   Debug.Trace.print test5-  Debug.Trace.print test6   Debug.Trace.print test7-  Debug.Trace.print (test8 100)+  Debug.Trace.print (test8 100.0)

+ examples/passing/Let2.purs view

@@ -0,0 +1,17 @@+module Main where++import Prelude++test =+  let f :: Number -> Boolean+      f 0.0 = false+      f n = g (n - 1.0)++      g :: Number -> Boolean+      g 0.0 = true+      g n = f (n - 1.0)++      x = f 1.0+  in not x++main = Debug.Trace.print test

examples/passing/LetInInstance.purs view

@@ -1,5 +1,7 @@ module Main where +import Prelude+ class Foo a where   foo :: a -> String

examples/passing/LiberalTypeSynonyms.purs view

@@ -1,5 +1,7 @@ module Main where +import Prelude+ type Reader = (->) String  foo :: Reader String

examples/passing/Match.purs view

@@ -1,7 +1,9 @@ module Main where -  data Foo a = Foo+import Prelude -  foo = \f -> case f of Foo -> "foo"+data Foo a = Foo -  main = Debug.Trace.trace "Done"+foo = \f -> case f of Foo -> "foo"++main = Debug.Trace.trace "Done"

+ examples/passing/ModuleExport.purs view

@@ -0,0 +1,9 @@+module A (module Prelude) where+  import Prelude++module Main where+  import Debug.Trace+  import A++  main = do+    print (show 1.0)

+ examples/passing/ModuleExportDupes.purs view

@@ -0,0 +1,19 @@+module A (module Prelude) where+  import Prelude++module B (module Prelude) where+  import Prelude++module C (module Prelude, module A) where+  import Prelude+  import A++module Main where+  import Debug.Trace+  import A+  import B+  import C+  import Prelude++  main = do+    print (show 1.0)

+ examples/passing/ModuleExportExcluded.purs view

@@ -0,0 +1,14 @@+module A (module Prelude, foo) where+  import Prelude++  foo :: Number -> Number+  foo _ = 0.0++module Main where+  import Debug.Trace+  import A (foo)++  otherwise = false++  main = do+    print "1.0"

+ examples/passing/ModuleExportHiding.purs view

@@ -0,0 +1,11 @@+module A (module Prelude) where+  import Prelude++module Main where+  import Debug.Trace+  import A hiding (module Prelude)++  otherwise = false++  main = do+    print "1.0"

+ examples/passing/ModuleExportQualified.purs view

@@ -0,0 +1,9 @@+module A (module Prelude) where+  import Prelude++module Main where+  import Debug.Trace+  import qualified A as B++  main = do+    print (B.show 1.0)

+ examples/passing/ModuleExportSelf.purs view

@@ -0,0 +1,14 @@+module A (module A, module Prelude) where+  import Prelude++  type Foo = Boolean++module Main where+  import Debug.Trace+  import A++  bar :: Foo+  bar = true++  main = do+    print (show bar)

examples/passing/Monad.purs view

@@ -1,32 +1,32 @@ module Main where -  import Prelude ()+import Prelude () -  type Monad m = { return :: forall a. a -> m a-		 , bind :: forall a b. m a -> (a -> m b) -> m b }+type Monad m = { return :: forall a. a -> m a+	 , bind :: forall a b. m a -> (a -> m b) -> m b } -  data Id a = Id a+data Id a = Id a -  id :: Monad Id-  id = { return : Id-       , bind : \ma f -> case ma of Id a -> f a }+id :: Monad Id+id = { return : Id+     , bind : \ma f -> case ma of Id a -> f a } -  data Maybe a = Nothing | Just a+data Maybe a = Nothing | Just a -  maybe :: Monad Maybe-  maybe = { return : Just-	  , bind : \ma f -> case ma of-	      Nothing -> Nothing-	      Just a -> f a-	  }+maybe :: Monad Maybe+maybe = { return : Just+  , bind : \ma f -> case ma of+      Nothing -> Nothing+      Just a -> f a+  } -  test :: forall m. Monad m -> m Number-  test = \m -> m.bind (m.return 1) (\n1 ->-		 m.bind (m.return "Test") (\n2 ->-		   m.return n1))+test :: forall m. Monad m -> m Number+test = \m -> m.bind (m.return 1.0) (\n1 ->+	 m.bind (m.return "Test") (\n2 ->+	   m.return n1)) -  test1 = test id+test1 = test id -  test2 = test maybe+test2 = test maybe -  main = Debug.Trace.trace "Done"+main = Debug.Trace.trace "Done"

examples/passing/MonadState.purs view

@@ -22,7 +22,7 @@   pure a = State $ \s -> Tuple s a  instance bindState :: Bind (State s) where-  (>>=) f g = State $ \s -> case runState s f of+  bind f g = State $ \s -> case runState s f of                               Tuple s1 a -> runState s1 (g a)  instance monadState :: Monad (State s)

examples/passing/MultiArgFunctions.purs view

@@ -1,5 +1,6 @@ module Main where +import Prelude import Data.Function import Control.Monad.Eff import Debug.Trace@@ -7,20 +8,20 @@ f = mkFn2 $ \a b -> runFn2 g a b + runFn2 g b a  g = mkFn2 $ \a b -> case {} of-  _ | a <= 0 || b <= 0 -> b-  _ -> runFn2 f (a - 1) (b - 1)+  _ | a <= 0.0 || b <= 0.0 -> b+  _ -> runFn2 f (a - 0.0) (b - 0.0)  main = do-  runFn0 (mkFn0 $ \_ -> trace $ show 0)-  runFn1 (mkFn1 $ \a -> trace $ show a) 1-  runFn2 (mkFn2 $ \a b -> trace $ show [a, b]) 1 2-  runFn3 (mkFn3 $ \a b c -> trace $ show [a, b, c]) 1 2 3-  runFn4 (mkFn4 $ \a b c d -> trace $ show [a, b, c, d]) 1 2 3 4-  runFn5 (mkFn5 $ \a b c d e -> trace $ show [a, b, c, d, e]) 1 2 3 4 5-  runFn6 (mkFn6 $ \a b c d e f -> trace $ show [a, b, c, d, e, f]) 1 2 3 4 5 6-  runFn7 (mkFn7 $ \a b c d e f g -> trace $ show [a, b, c, d, e, f, g]) 1 2 3 4 5 6 7-  runFn8 (mkFn8 $ \a b c d e f g h -> trace $ show [a, b, c, d, e, f, g, h]) 1 2 3 4 5 6 7 8-  runFn9 (mkFn9 $ \a b c d e f g h i -> trace $ show [a, b, c, d, e, f, g, h, i]) 1 2 3 4 5 6 7 8 9-  runFn10 (mkFn10 $ \a b c d e f g h i j-> trace $ show [a, b, c, d, e, f, g, h, i, j]) 1 2 3 4 5 6 7 8 9 10-  print $ runFn2 g 15 12+  runFn0 (mkFn0 $ \_ -> trace $ show 0.0)+  runFn1 (mkFn1 $ \a -> trace $ show a) 0.0+  runFn2 (mkFn2 $ \a b -> trace $ show [a, b]) 0.0 0.0+  runFn3 (mkFn3 $ \a b c -> trace $ show [a, b, c]) 0.0 0.0 0.0+  runFn4 (mkFn4 $ \a b c d -> trace $ show [a, b, c, d]) 0.0 0.0 0.0 0.0+  runFn5 (mkFn5 $ \a b c d e -> trace $ show [a, b, c, d, e]) 0.0 0.0 0.0 0.0 0.0+  runFn6 (mkFn6 $ \a b c d e f -> trace $ show [a, b, c, d, e, f]) 0.0 0.0 0.0 0.0 0.0 0.0+  runFn7 (mkFn7 $ \a b c d e f g -> trace $ show [a, b, c, d, e, f, g]) 0.0 0.0 0.0 0.0 0.0 0.0 0.0+  runFn8 (mkFn8 $ \a b c d e f g h -> trace $ show [a, b, c, d, e, f, g, h]) 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0+  runFn9 (mkFn9 $ \a b c d e f g h i -> trace $ show [a, b, c, d, e, f, g, h, i]) 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0+  runFn10 (mkFn10 $ \a b c d e f g h i j-> trace $ show [a, b, c, d, e, f, g, h, i, j]) 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0+  print $ runFn2 g 0.0 0.0   trace "Done!"

− examples/passing/MultipleConstructorArgs.purs

@@ -1,21 +0,0 @@-module Main where--import Prelude-import Control.Monad.Eff--data P a b = P a b--runP :: forall a b r. (a -> b -> r) -> P a b -> r-runP f (P a b) = f a b--idP = runP P--testCase = \p -> case p of-  P (x:xs) (y:ys) -> x + y-  P _ _ -> 0--test1 = testCase (P [1, 2, 3] [4, 5, 6])--main = do-  Debug.Trace.trace (runP (\s n -> s ++ show n) (P "Test" 1))-  Debug.Trace.print test1

examples/passing/MutRec.purs view

@@ -1,19 +1,19 @@ module Main where -  import Prelude+import Prelude -  f 0 = 0-  f x = g x + 1+f 0.0 = 0.0+f x = g x + 0.0 -  g x = f (x / 2)+g x = f (x / 0.0) -  data Even = Zero | Even Odd+data Even = Zero | Even Odd -  data Odd = Odd Even+data Odd = Odd Even -  evenToNumber Zero = 0-  evenToNumber (Even n) = oddToNumber n + 1+evenToNumber Zero = 0.0+evenToNumber (Even n) = oddToNumber n + 0.0 -  oddToNumber (Odd n) = evenToNumber n + 1+oddToNumber (Odd n) = evenToNumber n + 0.0 -  main = Debug.Trace.trace "Done"+main = Debug.Trace.trace "Done"

examples/passing/MutRec2.purs view

@@ -1,5 +1,7 @@ module Main where +import Prelude+ data A = A B  data B = B A

examples/passing/MutRec3.purs view

@@ -1,5 +1,7 @@ module Main where +import Prelude+ data A = A B  data B = B A

examples/passing/NamedPatterns.purs view

@@ -1,7 +1,9 @@ module Main where -  foo = \x -> case x of-    y@{ foo = "Foo" } -> y-    y -> y+import Prelude -  main = Debug.Trace.trace "Done"+foo = \x -> case x of+  y@{ foo = "Foo" } -> y+  y -> y++main = Debug.Trace.trace "Done"

examples/passing/NegativeBinder.purs view

@@ -1,7 +1,9 @@ module Main where +import Prelude+ test :: Number -> Boolean-test -1 = false+test -1.0 = false test _  = true  main = Debug.Trace.trace "Done"

examples/passing/Nested.purs view

@@ -1,7 +1,9 @@ module Main where -  data Extend r a = Extend { prev :: r a, next :: a }+import Prelude -  data Matrix r a = Square (r (r a)) | Bigger (Matrix (Extend r) a)+data Extend r a = Extend { prev :: r a, next :: a } -  main = Debug.Trace.trace "Done"+data Matrix r a = Square (r (r a)) | Bigger (Matrix (Extend r) a)++main = Debug.Trace.trace "Done"

examples/passing/NestedTypeSynonyms.purs view

@@ -1,11 +1,11 @@ module Main where -  import Prelude+import Prelude -  type X = String-  type Y = X -> X+type X = String+type Y = X -> X -  fn :: Y-  fn a = a+fn :: Y+fn a = a -  main = Debug.Trace.print (fn "Done")+main = Debug.Trace.print (fn "Done")

examples/passing/NestedWhere.purs view

@@ -1,10 +1,12 @@ module Main where +import Prelude+ f x = g x   where   g x = go x     where-    go x = go1 (x - 1)+    go x = go1 (x - 1.0)     go1 x = go x  main = Debug.Trace.trace "Done"

examples/passing/Newtype.purs view

@@ -1,5 +1,6 @@ module Main where +import Prelude import Control.Monad.Eff import Debug.Trace @@ -17,6 +18,6 @@  main = do   print $ Thing "hello"-  print $ Box 42-  print $ apply Box 9000+  print $ Box 42.0+  print $ apply Box 9000.0   trace "Done"

examples/passing/NewtypeEff.purs view

@@ -1,5 +1,6 @@ module Main where +import Prelude import Debug.Trace import Control.Monad.Eff @@ -18,7 +19,7 @@   pure t = T (pure t)  instance bindT :: Bind T where-  (>>=) (T t) f = T (t >>= \x -> runT (f x))+  bind (T t) f = T (t >>= \x -> runT (f x))  instance monadT :: Monad T

examples/passing/NewtypeWithRecordUpdate.purs view

@@ -1,15 +1,16 @@--- https://github.com/purescript/purescript/issues/812+-- https://github.com/purescript/purescript/issues/812.0  module Main where +import Prelude import Debug.Trace  newtype NewType a = NewType (Object a)  rec1 :: Object (a :: Number, b :: Number, c:: Number)-rec1 = { a: 0, b: 0, c: 0 } +rec1 = { a: 0.0, b: 0.0, c: 0.0 }  rec2 :: NewType (a :: Number, b :: Number, c :: Number)-rec2 = NewType (rec1 { a = 1 })+rec2 = NewType (rec1 { a = 1.0 })  main = trace "Done"

examples/passing/ObjectGetter.purs view

@@ -1,8 +1,10 @@ module Main where +import Prelude+ getX = _.x -point = { x: 1, y: 0 }+point = { x: 1.0, y: 0.0 }  main = do   Debug.Trace.print $ getX point

examples/passing/ObjectSynonym.purs view

@@ -1,9 +1,11 @@ module Main where +import Prelude+ type Inner = Number  inner :: Inner-inner = 0+inner = 0.0  type Outer = { inner :: Inner }

examples/passing/ObjectUpdate.purs view

@@ -1,18 +1,20 @@ module Main where -  update1 = \o -> o { foo = "Foo" }+import Prelude -  update2 :: forall r. { foo :: String | r } -> { foo :: String | r }-  update2 = \o -> o { foo = "Foo" }+update1 = \o -> o { foo = "Foo" } -  replace = \o -> case o of-    { foo = "Foo" } -> o { foo = "Bar" }-    { foo = "Bar" } -> o { bar = "Baz" }-    o -> o+update2 :: forall r. { foo :: String | r } -> { foo :: String | r }+update2 = \o -> o { foo = "Foo" } -  polyUpdate :: forall a r. { foo :: a | r } -> { foo :: String | r }-  polyUpdate = \o -> o { foo = "Foo" }+replace = \o -> case o of+  { foo = "Foo" } -> o { foo = "Bar" }+  { foo = "Bar" } -> o { bar = "Baz" }+  o -> o -  inferPolyUpdate = \o -> o { foo = "Foo" }+polyUpdate :: forall a r. { foo :: a | r } -> { foo :: String | r }+polyUpdate = \o -> o { foo = "Foo" } -  main = Debug.Trace.trace ((update1 {foo: ""}).foo)+inferPolyUpdate = \o -> o { foo = "Foo" }++main = Debug.Trace.trace ((update1 {foo: ""}).foo)

examples/passing/ObjectUpdate2.purs view

@@ -1,8 +1,11 @@ module Main where +import Prelude+ type X r = { | r } -foreign import x "var x = {};" :: forall r. X r+x :: X (baz :: String)+x = { baz: "baz" }  blah :: forall r. X r -> X r blah x = x

examples/passing/ObjectUpdater.purs view

@@ -1,20 +1,9 @@ module Main where +import Prelude import Control.Monad.Eff import Debug.Trace--foreign import eqeqeq-  """-  function eqeqeq(x) {-    return function (y) {-      if (x == y) return x;-      throw new Error("Unexpected result: " + x + " /== " + y);-    };-  };-  """ :: forall a. a -> a -> a--(===) = eqeqeq-infixl 4 ===+import Assert  getValue :: forall e. Eff (| e) Boolean getValue = return true@@ -22,14 +11,14 @@ main = do   let record = { value: false }   record' <- record { value = _ } <$> getValue-  print $ record'.value === true+  assert $ record'.value == true -  let point = { x: 1, y: 1 }-      x = 10-      point' = (point { x = _, y = x }) 100+  let point = { x: 1.0, y: 1.0 }+      x = 10.0+      point' = (point { x = _, y = x }) 100.0 -  print $ point'.x === 100-  print $ point'.y === 10+  assert $ point'.x == 100.0+  assert $ point'.y == 10.0 -  let record2 = (_ { x = _ }) { x: 0 } 10-  print $ record2.x === 10+  let record2 = (_ { x = _ }) { x: 0.0 } 10.0+  assert $ record2.x == 10.0

examples/passing/ObjectWildcards.purs view

@@ -1,31 +1,20 @@ module Main where +import Prelude import Control.Monad.Eff import Debug.Trace+import Assert  mkRecord = { foo: _, bar: _, baz: "baz" }  getValue :: forall e. Eff (| e) Boolean getValue = return true -foreign import eqeqeq-  """-  function eqeqeq(x) {-    return function (y) {-      if (x == y) return x;-      throw new Error("Unexpected result: " + x + " /== " + y);-    };-  };-  """ :: forall a. a -> a -> a--(===) = eqeqeq-infixl 4 ===- main = do   obj <- { value: _ } <$> getValue   print obj.value-  let x = 1-  point <- { x: _, y: x } <$> return 2-  print $ point.x === 2-  print $ point.y === 1-  trace (mkRecord 1 "Done!").bar+  let x = 1.0+  point <- { x: _, y: x } <$> return 2.0+  assert $ point.x == 2.0+  assert $ point.y == 1.0+  trace (mkRecord 1.0 "Done!").bar

examples/passing/Objects.purs view

@@ -1,35 +1,35 @@ module Main where -  import Prelude+import Prelude -  test = \x -> x.foo + x.bar + 1+test = \x -> x.foo + x.bar + 1.0 -  append = \o -> { foo: o.foo, bar: 1 }+append = \o -> { foo: o.foo, bar: 1.0 } -  apTest = append({foo : "Foo", baz: "Baz"})+apTest = append({foo : "Foo", baz: "Baz"}) -  f = (\a -> a.b.c) { b: { c: 1, d: "Hello" }, e: "World" }+f = (\a -> a.b.c) { b: { c: 1.0, d: "Hello" }, e: "World" } -  g = (\a -> a.f { x: 1, y: "y" }) { f: \o -> o.x + 1 }+g = (\a -> a.f { x: 1.0, y: "y" }) { f: \o -> o.x + 1.0 } -  typed :: { foo :: Number }-  typed = { foo: 0 }+typed :: { foo :: Number }+typed = { foo: 0.0 } -  test2 = \x -> x."!@#"+test2 = \x -> x."!@#" -  test3 = typed."foo"+test3 = typed."foo" -  test4 = test2 weirdObj-    where-    weirdObj :: { "!@#" :: Number }-    weirdObj = { "!@#": 1 }+test4 = test2 weirdObj+  where+  weirdObj :: { "!@#" :: Number }+  weirdObj = { "!@#": 1.0 } -  test5 = case { "***": 1 } of-    { "***" = n } -> n+test5 = case { "***": 1.0 } of+  { "***" = n } -> n -  test6 = case { "***": 1 } of-               { "***": n } -> n+test6 = case { "***": 1.0 } of+             { "***": n } -> n -  test7 {a:    snoog , b     : blah } = blah+test7 {a:    snoog , b     : blah } = blah -  main = Debug.Trace.trace "Done"+main = Debug.Trace.trace "Done"

examples/passing/OneConstructor.purs view

@@ -1,5 +1,7 @@ module Main where +import Prelude+ data One a = One a  one' (One a) = a

examples/passing/OperatorAssociativity.purs view

@@ -1,58 +1,25 @@ module Main where +import Prelude import Control.Monad.Eff import Debug.Trace--foreign import data Assert :: !--foreign import assert-  """-  function assert(x) {-    return function(desc) {-      return function() {-        if (!x) throw new Error('assertion (' + desc + ') failed');-        return {};-      };-    };-  }-  """ :: forall e. Boolean -> String -> Eff (assert :: Assert | e) Unit+import Assert  bug :: Number -> Number -> Number-bug a b = 0 - (a - b)--foreign import explode-  """-  function explode() {-    throw new Error('Assertion failed!');-  }-  """ :: forall eff a. Eff eff a+bug a b = 0.0 - (a - b)  main = do-    assert (bug 0 2 == 2)       "bug 0 2 == 2"-    assert (0 - (0 - 2) == 2)   "0 - (0 - 2) == 2"-    assert (0 - (0 + 2) == -2)  "0 - (0 + 2) == -2"--    assert (6 / (3 * 2) == 1)   "6 / (3 * 2) == 1"-    assert ((6 / 3) * 2 == 4)   "(6 / 3) * 2 == 4"--    assert (6 % (2 * 2) == 2)   "6 % (2 * 2) == 2"-    assert ((6 % 2) * 2 == 0)   "(6 % 2) * 2 == 0"--    assert (4 % (9 / 3) == 1)   "4 % (9 / 3) == 1"-    assert ((4 % 9) / 2 == 2)   "(4 % 9) / 2 == 2"--    assert (not (1 < 0) == true) "not (1 < 0) == true"-    assert (not (complement (1 + 10) == 8) == true) "not (complement (1 + 10) == 8) == true"-    assert (not ((negate 1) < 0) == false) "not ((negate 1) < 0) == false"--    assert (negate (1 + 10) == -11) "negate (1 + 10) == -11"--    assert (2 * 3 / 4 == 1.5) "2 * 3 / 4 == 1.5"-    assert (1 * 2 * 3 * 4 * 5 / 6 == 20) "1 * 2 * 3 * 4 * 5 / 6 == 20"-    assert (complement (2 / 3 * 4) == -3) "complement (2 / 3 * 4) == -3"--    assert (1 + 10 - 5 == 6) "1 + 10 - 5 == 6"-    assert (1 + 10 * 5 == 51) "1 + 10 * 5 == 51"-    assert (10 * 5 - 1 == 49) "10 * 5 - 1 == 49"--    trace "Success!"+  assert (bug 0.0 2.0 == 2.0)+  assert (0.0 - (0.0 - 2.0) == 2.0)+  assert (0.0 - (0.0 + 2.0) == -2.0)+  assert (6.0 / (3.0 * 2.0) == 1.0)+  assert ((6.0 / 3.0) * 2.0 == 4.0)+  assert (not (1.0 < 0.0) == true)+  assert (not ((negate 1.0) < 0.0) == false)+  assert (negate (1.0 + 10.0) == -11.0)+  assert (2.0 * 3.0 / 4.0 == 1.5)+  assert (1.0 * 2.0 * 3.0 * 4.0 * 5.0 / 6.0 == 20.0)+  assert (1.0 + 10.0 - 5.0 == 6.0)+  assert (1.0 + 10.0 * 5.0 == 51.0)+  assert (10.0 * 5.0 - 1.0 == 49.0)+  trace "Success!"

+ examples/passing/OperatorInlining.purs view

@@ -0,0 +1,47 @@+module Main where++import Prelude+import Debug.Trace++main = do++  -- semiringNumber+  print (1.0 + 2.0)+  print (1.0 * 2.0)++  -- ringNumber+  print (1.0 - 2.0)+  print (negate 1.0)++  -- moduleSemiringNumber+  print (1.0 / 2.0)++  -- ordNumber+  print (1.0 > 2.0)+  print (1.0 < 2.0)+  print (1.0 <= 2.0)+  print (1.0 >= 2.0)+  print (1.0 == 2.0)++  -- eqNumber+  print (1.0 == 2.0)+  print (1.0 /= 2.0)++  -- eqString+  print ("foo" == "bar")+  print ("foo" /= "bar")++  -- eqBoolean+  print (true == false)+  print (true /= false)++  -- semigroupString+  print ("foo" ++ "bar")+  print ("foo" <> "bar")++  -- latticeBoolean+  print (top && true)+  print (bottom || false)++  -- complementedLatticeBoolean+  print (not true)

examples/passing/OperatorSections.purs view

@@ -1,21 +1,11 @@ module Main where -foreign import eqeqeq-  """-  function eqeqeq(x) {-    return function (y) {-      if (x == y) return x;-      throw new Error("Unexpected result: " + x + " /== " + y);-    };-  };-  """ :: forall a. a -> a -> a--(===) = eqeqeq-infixl 4 ===+import Prelude+import Assert  main = do-  Debug.Trace.print $ (/ 2) 4 === 2-  Debug.Trace.print $ (2 /) 4 === 0.5-  Debug.Trace.print $ (`const` 1) 2 === 2-  Debug.Trace.print $ (1 `const`) 2 === 1+  assert $ (/ 2.0) 4.0 == 2.0+  assert $ (2.0 /) 4.0 == 0.5+  assert $ (`const` 1.0) 2.0 == 2.0+  assert $ (1.0 `const`) 2.0 == 1.0   Debug.Trace.trace "Done!"

examples/passing/Operators.purs view

@@ -1,102 +1,99 @@ module Main where -  import Control.Monad.Eff-  import Debug.Trace--  (?!) :: forall a. a -> a -> a-  (?!) x _ = x+import Prelude+import Control.Monad.Eff+import Debug.Trace -  bar :: String -> String -> String-  bar = \s1 s2 -> s1 ++ s2+(?!) :: forall a. a -> a -> a+(?!) x _ = x -  test1 :: forall n. (Num n) => n -> n -> (n -> n -> n) -> n-  test1 x y z = x * y + z x y+bar :: String -> String -> String+bar = \s1 s2 -> s1 ++ s2 -  test2 = (\x -> x.foo false) { foo : \_ -> 1 }+test1 :: forall n. (Num n) => n -> n -> (n -> n -> n) -> n+test1 x y z = x * y + z x y -  test3 = (\x y -> x)(1 + 2 * (1 + 2)) (true && (false || false))+test2 = (\x -> x.foo false) { foo : \_ -> 1.0 } -  k = \x -> \y -> x+test3 = (\x y -> x)(1.0 + 2.0 * (1.0 + 2.0)) (true && (false || false)) -  test4 = 1 `k` 2+k = \x -> \y -> x -  infixl 5 %%+test4 = 1 `k` 2 -  (%%) :: Number -> Number -> Number-  (%%) x y = x * y + y+infixl 5 %% -  test5 = 1 %% 2 %% 3+(%%) :: Number -> Number -> Number+(%%) x y = x * y + y -  test6 = ((\x -> x) `k` 2) 3+test5 = 1.0 %% 2.0 %% 3.0 -  (<+>) :: String -> String -> String-  (<+>) = \s1 s2 -> s1 ++ s2+test6 = ((\x -> x) `k` 2.0) 3.0 -  test7 = "Hello" <+> "World!"+(<+>) :: String -> String -> String+(<+>) = \s1 s2 -> s1 ++ s2 -  (@@) :: forall a b. (a -> b) -> a -> b-  (@@) = \f x -> f x+test7 = "Hello" <+> "World!" -  foo :: String -> String-  foo = \s -> s+(@@) :: forall a b. (a -> b) -> a -> b+(@@) = \f x -> f x -  test8 = foo @@ "Hello World"+foo :: String -> String+foo = \s -> s -  test9 = Main.foo @@ "Hello World"+test8 = foo @@ "Hello World" -  test10 = "Hello" `Main.bar` "World"+test9 = Main.foo @@ "Hello World" -  (...) :: forall a. [a] -> [a] -> [a]-  (...) = \as -> \bs -> as+test10 = "Hello" `Main.bar` "World" -  test11 = [1, 2, 3] ... [4, 5, 6]+(...) :: forall a. Array a -> Array a -> Array a+(...) = \as -> \bs -> as -  test12 (<%>) a b = a <%> b+test11 = [1.0, 2.0, 0.0] ... [4.0, 5.0, 6.0] -  test13 = \(<%>) a b -> a <%> b+test12 (<%>) a b = a <%> b -  test14 :: Number -> Number -> Boolean-  test14 a b = a < b+test13 = \(<%>) a b -> a <%> b -  test15 :: Number -> Number -> Boolean-  test15 a b = const false $ a `test14` b+test14 :: Number -> Number -> Boolean+test14 a b = a < b -  test16 :: Number -> Number -> Number-  test16 x y = x .|. y .&. y+test15 :: Number -> Number -> Boolean+test15 a b = const false $ a `test14` b -  test17 :: Number-  test17 = negate (-1)+test17 :: Number+test17 = negate (-1.0) -  test18 :: Number-  test18 = negate $ negate 1+test18 :: Number+test18 = negate $ negate 1.0 -  test19 :: Number-  test19 = negate $ negate (-1)+test19 :: Number+test19 = negate $ negate (-1.0) -  test20 :: Number-  test20 = 1 @ 2-    where-    (@) x y = x + y * y+test20 :: Number+test20 = 1.0 @ 2.0+  where+  (@) x y = x + y * y -  main = do-    let t1 = test1 1 2 (\x y -> x + y)-    let t2 = test2-    let t3 = test3-    let t4 = test4-    let t5 = test5-    let t6 = test6-    let t7 = test7-    let t8 = test8-    let t9 = test9-    let t10 = test10-    let t11 = test11-    let t12 = test12 k 1 2-    let t13 = test13 k 1 2-    let t14 = test14 1 2-    let t15 = test15 1 2-    let t16 = test16 1 2-    let t17 = test17-    let t18 = test18-    let t19 = test19-    let t20 = test20-    trace "Done"+main = do+  let t1 = test1 1.0 2.0 (\x y -> x + y)+  let t2 = test2+  let t3 = test3+  let t4 = test4+  let t5 = test5+  let t6 = test6+  let t7 = test7+  let t8 = test8+  let t9 = test9+  let t10 = test10+  let t11 = test11+  let t12 = test12 k 1.0 2.0+  let t13 = test13 k 1.0 2.0+  let t14 = test14 1.0 2.0+  let t15 = test15 1.0 2.0+  let t17 = test17+  let t18 = test18+  let t19 = test19+  let t20 = test20+  trace "Done"

examples/passing/OptimizerBug.purs view

@@ -2,7 +2,7 @@  import Prelude -x a = 1 + y a+x a = 1.0 + y a  y a = x a

examples/passing/PartialFunction.purs view

@@ -1,19 +1,10 @@ module Main where -foreign import testError-  """-  function testError(f) {-    try {-      return f();-    } catch (e) {-      if (e instanceof Error) return 'success';-      throw new Error('Pattern match failure is not Error');-    }-  }-  """ :: (Unit -> Number) -> String+import Prelude+import Assert  fn :: Number -> Number-fn 0 = 0-fn 1 = 2+fn 0.0 = 0.0+fn 1.0 = 2.0 -main = Debug.Trace.trace (show $ testError $ \_ -> fn 2)+main = assertPartial $ \_ -> fn 2.0

examples/passing/Patterns.purs view

@@ -1,28 +1,22 @@ module Main where -  import Prelude--  test = \x -> case x of-    { str = "Foo", bool = true } -> true-    { str = "Bar", bool = b } -> b-    _ -> false--  f = \o -> case o of-    { foo = "Foo" } -> o.bar-    _ -> 0+import Prelude -  g = \o -> case o of-    { arr = [x : xs], take = "car" } -> x-    { arr = [_, x : xs], take = "cadr" } -> x-    _ -> 0+test = \x -> case x of+  { str = "Foo", bool = true } -> true+  { str = "Bar", bool = b } -> b+  _ -> false +f = \o -> case o of+  { foo = "Foo" } -> o.bar+  _ -> 0 -  h = \o -> case o of-    a@[_,_,_] -> a-    _ -> []+h = \o -> case o of+  a@[_,_,_] -> a+  _ -> [] -  isDesc :: [Number] -> Boolean-  isDesc [x, y] | x > y = true-  isDesc _ = false+isDesc :: Array Number -> Boolean+isDesc [x, y] | x > y = true+isDesc _ = false -  main = Debug.Trace.trace "Done"+main = Debug.Trace.trace "Done"

examples/passing/Person.purs view

@@ -1,18 +1,11 @@ module Main where -  import Prelude ((++))--  data Person = Person { name :: String, age :: Number }+import Prelude -  foreign import itoa-    """-    function itoa(n) {-      return n.toString();-    }-    """ :: Number -> String+data Person = Person { name :: String, age :: Number } -  showPerson :: Person -> String-  showPerson = \p -> case p of-    Person o -> o.name ++ ", aged " ++ itoa(o.age)+showPerson :: Person -> String+showPerson = \p -> case p of+  Person o -> o.name ++ ", aged " ++ show o.age -  main = Debug.Trace.trace "Done"+main = Debug.Trace.trace "Done"

examples/passing/Rank2Data.purs view

@@ -1,29 +1,29 @@ module Main where -  import Prelude+import Prelude -  data Id = Id forall a. a -> a+data Id = Id forall a. a -> a -  runId = \id a -> case id of-    Id f -> f a+runId = \id a -> case id of+  Id f -> f a -  data Nat = Nat forall r. r -> (r -> r) -> r+data Nat = Nat forall r. r -> (r -> r) -> r -  runNat = \nat -> case nat of-    Nat f -> f 0 (\n -> n + 1)+runNat = \nat -> case nat of+  Nat f -> f 0.0 (\n -> n + 1.0) -  zero' = Nat (\zero' _ -> zero')+zero' = Nat (\zero' _ -> zero') -  succ = \n -> case n of-    Nat f -> Nat (\zero' succ -> succ (f zero' succ))+succ = \n -> case n of+  Nat f -> Nat (\zero' succ -> succ (f zero' succ)) -  add = \n m -> case n of-    Nat f -> case m of-      Nat g -> Nat (\zero' succ -> g (f zero' succ) succ)+add = \n m -> case n of+  Nat f -> case m of+    Nat g -> Nat (\zero' succ -> g (f zero' succ) succ) -  one' = succ zero'-  two = succ zero'-  four = add two two-  fourNumber = runNat four+one' = succ zero'+two = succ zero'+four = add two two+fourNumber = runNat four -  main = Debug.Trace.trace "Done'"+main = Debug.Trace.trace "Done'"

examples/passing/Rank2Object.purs view

@@ -1,10 +1,11 @@ module Main where +import Prelude import Debug.Trace  data Foo = Foo { id :: forall a. a -> a }  foo :: Foo -> Number-foo (Foo { id = f }) = f 0+foo (Foo { id = f }) = f 0.0  main = trace "Done"

examples/passing/Rank2TypeSynonym.purs view

@@ -1,5 +1,6 @@ module Main where +import Prelude import Control.Monad.Eff  type Foo a = forall f. (Monad f) => f a@@ -8,7 +9,7 @@ foo x = pure x  bar :: Foo Number-bar = foo 3+bar = foo 3.0  main = do   x <- bar

examples/passing/Rank2Types.purs view

@@ -1,11 +1,11 @@ module Main where -  import Prelude+import Prelude -  test1 :: (forall a. (a -> a)) -> Number-  test1 = \f -> f 0+test1 :: (forall a. (a -> a)) -> Number+test1 = \f -> f 0.0 -  forever :: forall m a b. (forall a b. m a -> (a -> m b) -> m b) -> m a -> m b-  forever = \bind action -> bind action $ \_ -> forever bind action+forever :: forall m a b. (forall a b. m a -> (a -> m b) -> m b) -> m a -> m b+forever = \bind action -> bind action $ \_ -> forever bind action -  main = Debug.Trace.trace "Done"+main = Debug.Trace.trace "Done"

+ examples/passing/RebindableSyntax.purs view

@@ -0,0 +1,39 @@+module Main where++import Prelude++example1 :: String+example1 = do+  "Do"+  " notation"+  " for"+  " Semigroup"+  where+  bind x f = x <> f unit++(*>) :: forall f a b. (Apply f) => f a -> f b -> f b+(*>) fa fb = const id <$> fa <*> fb++newtype Const a b = Const a++runConst :: forall a b. Const a b -> a+runConst (Const a) = a++instance functorConst :: Functor (Const a) where+  (<$>) _ (Const a) = Const a++instance applyConst :: (Semigroup a) => Apply (Const a) where+  (<*>) (Const a1) (Const a2) = Const (a1 <> a2)++example2 :: Const String Unit+example2 = do+  Const "Do"+  Const " notation"+  Const " for"+  Const " Apply"+  where+  bind x f = x *> f unit++main = do+  Debug.Trace.trace example1+  Debug.Trace.trace $ runConst example2

examples/passing/Recursion.purs view

@@ -1,10 +1,10 @@ module Main where -  import Prelude+import Prelude -  fib = \n -> case n of-    0 -> 1-    1 -> 1-    n -> fib (n - 1) + fib (n - 2)+fib = \n -> case n of+  0.0 -> 1.0+  1.0 -> 1.0+  n -> fib (n - 1.0) + fib (n - 2.0) -  main = Debug.Trace.trace "Done"+main = Debug.Trace.trace "Done"

examples/passing/ReservedWords.purs view

@@ -1,13 +1,15 @@ -- See https://github.com/purescript/purescript/issues/606 module Main where -  o :: { type :: String }-  o = { type: "o" }+import Prelude -  p :: { type :: String }-  p = o { type = "p" }+o :: { type :: String }+o = { type: "o" } -  f :: forall r. { type :: String | r } -> String-  f { type = "p" } = "Done"+p :: { type :: String }+p = o { type = "p" } -  main = Debug.Trace.trace $ f { type: p.type, foo: "bar" }+f :: forall r. { type :: String | r } -> String+f { type = "p" } = "Done"++main = Debug.Trace.trace $ f { type: p.type, foo: "bar" }

+ examples/passing/RowConstructors.purs view

@@ -0,0 +1,42 @@+module Main where++import Prelude++type Foo = (x :: Number | (y :: Number | (z :: Number)))+type Bar = (x :: Number, y :: Number, z :: Number)+type Baz = { w :: Number | Bar }++foo :: { | Foo }+foo = { x: 0.0, y: 0.0, z: 0.0 }++bar :: { | Bar }+bar = { x: 0.0, y: 0.0, z: 0.0 }++id' :: Object Foo -> Object Bar+id' = id++foo' :: { | Foo }+foo' = id' foo++bar' :: { | Bar }+bar' = id' bar++baz :: Baz+baz = { x: 0.0, y: 0.0, z: 0.0, w: 0.0 }++type Quux r = (q :: Number | r)+type Norf r = (q' :: Number | Quux r)++quux :: { f :: { | Foo } | Quux Bar }+quux = { f: foo', x: 0.0, y: 0.0, z: 0.0, q: 0.0 }++quux' :: { | Norf Bar }+quux' = { x: 0.0, y: 0.0, z: 0.0, q: 0.0, q': 0.0 }++wildcard :: { w :: Number | _ } -> Baz+wildcard { w: w } = { x: w, y: w, z: w, w: w }++wildcard' :: { | Quux _ } -> Number+wildcard' { q: q } = q++main = Debug.Trace.trace "Done"

examples/passing/RowPolyInstanceContext.purs view

@@ -1,5 +1,7 @@ module Main where +import Prelude+ class T s m where   state :: (s -> s) -> m Unit

− examples/passing/RowSynonyms.purs

@@ -1,46 +0,0 @@-module Main where--import Control.Monad.Eff-import Control.Monad.ST--type State bindings =-  {-    bindings :: {addition :: Number | bindings},-    other :: String-  }--type MyBindings = (test :: Number)--data Shadow bindings = Shadow String--shadows :: Shadow (Object MyBindings)-shadows = Shadow "uhh"--main :: Eff () Unit-main = withIt-          shadows-            \ bindings -> do-                let state =-                  {-                      bindings : bindings,-                      other : "Test"-                  }-                runST do-                  stRef <- newSTRef state-                  handleKeyD stRef-                  return unit---withIt :: forall bindings eff a. Shadow (Object bindings) ->-                ({addition :: Number | bindings} -> Eff eff a) -> Eff eff a-withIt (Shadow str) success = do-  b <- withBindings-  success (b{addition = 1})--foreign import withBindings-"""-        function withBindings() {}-""" :: forall eff bindings. Eff eff bindings--handleKeyD :: forall h eff. STRef h (State MyBindings) -> Eff (st :: ST h | eff) Unit-handleKeyD state = return unit

examples/passing/RuntimeScopeIssue.purs view

@@ -9,11 +9,11 @@   b :: a -> Boolean  instance aNumber :: A Number where-  a 0 = true-  a n = b (n - 1)+  a 0.0 = true+  a n = b (n - 1.0)  instance bNumber :: B Number where-  b 0 = false-  b n = a (n - 1)+  b 0.0 = false+  b n = a (n - 1.0) -main = Debug.Trace.print $ a 10+main = Debug.Trace.print $ a 10.0

examples/passing/ScopedTypeVariables.purs view

@@ -1,5 +1,7 @@ module Main where +import Prelude+ test1 :: forall a. (a -> a) -> a -> a test1 f x = g (g x)   where@@ -15,8 +17,8 @@     g :: b -> b     g y = f (f y) -test3 :: Number -test3 = ((\b -> b :: b) :: forall b. b -> b) 0+test3 :: Number+test3 = ((\b -> b :: b) :: forall b. b -> b) 0.0  test4 :: forall a. (a -> a) -> a -> a test4 = h

examples/passing/Sequence.purs view

@@ -1,12 +1,15 @@ module Main where +import Prelude import Control.Monad.Eff +data List a = Cons a (List a) | Nil+ class Sequence t where   sequence :: forall m a. (Monad m) => t (m a) -> m (t a) -instance sequenceArray :: Sequence [] where-  sequence [] = pure []-  sequence (x:xs) = (:) <$> x <*> sequence xs+instance sequenceList :: Sequence List where+  sequence Nil = pure Nil+  sequence (Cons x xs) = Cons <$> x <*> sequence xs -main = sequence $ [Debug.Trace.trace "Done"]+main = sequence $ Cons (Debug.Trace.trace "Done") Nil

examples/passing/SequenceDesugared.purs view

@@ -1,34 +1,37 @@ module Main where +import Prelude import Control.Monad.Eff +data List a = Cons a (List a) | Nil+ data Sequence t = Sequence (forall m a. (Monad m) => t (m a) -> m (t a))  sequence :: forall t. Sequence t -> (forall m a. (Monad m) => t (m a) -> m (t a)) sequence (Sequence s) = s -sequenceArraySeq :: forall m a. (Monad m) => Array (m a) -> m (Array a)-sequenceArraySeq [] = pure []-sequenceArraySeq (x:xs) = (:) <$> x <*> sequenceArraySeq xs+sequenceListSeq :: forall m a. (Monad m) => List (m a) -> m (List a)+sequenceListSeq Nil = pure Nil+sequenceListSeq (Cons x xs) = Cons <$> x <*> sequenceListSeq xs -sequenceArray :: Sequence []-sequenceArray = Sequence (sequenceArraySeq)+sequenceList :: Sequence List+sequenceList = Sequence (sequenceListSeq) -sequenceArray' :: Sequence []-sequenceArray' = Sequence ((\val -> case val of-  [] -> pure []-  (x:xs) -> (:) <$> x <*> sequence sequenceArray' xs))+sequenceList' :: Sequence List+sequenceList' = Sequence ((\val -> case val of+  Nil -> pure Nil+  Cons x xs -> Cons <$> x <*> sequence sequenceList' xs)) -sequenceArray'' :: Sequence []-sequenceArray'' = Sequence (sequenceArraySeq :: forall m a. (Monad m) => Array (m a) -> m (Array a))+sequenceList'' :: Sequence List+sequenceList'' = Sequence (sequenceListSeq :: forall m a. (Monad m) => List (m a) -> m (List a)) -sequenceArray''' :: Sequence []-sequenceArray''' = Sequence ((\val -> case val of-  [] -> pure []-  (x:xs) -> (:) <$> x <*> sequence sequenceArray''' xs) :: forall m a. (Monad m) => Array (m a) -> m (Array a))+sequenceList''' :: Sequence List+sequenceList''' = Sequence ((\val -> case val of+  Nil -> pure Nil+  Cons x xs -> Cons <$> x <*> sequence sequenceList''' xs) :: forall m a. (Monad m) => List (m a) -> m (List a))  main = do-  sequence sequenceArray $ [Debug.Trace.trace "Done"]-  sequence sequenceArray' $ [Debug.Trace.trace "Done"]-  sequence sequenceArray'' $ [Debug.Trace.trace "Done"]-  sequence sequenceArray''' $ [Debug.Trace.trace "Done"]+  sequence sequenceList $ Cons (Debug.Trace.trace "Done") Nil+  sequence sequenceList' $ Cons (Debug.Trace.trace "Done") Nil+  sequence sequenceList'' $ Cons (Debug.Trace.trace "Done") Nil+  sequence sequenceList''' $ Cons (Debug.Trace.trace "Done") Nil

examples/passing/ShadowedRename.purs view

@@ -1,21 +1,14 @@ module Main where +import Prelude import Control.Monad.Eff import Debug.Trace--foreign import f-  """-  function f(x) {-    return function() {-      if (x !== 2) throw new Error('x is not 2');-    };-  }-  """ :: forall e. Number -> Eff e Number+import Assert  foo foo = let foo_1 = \_ -> foo-              foo_2 = foo_1 unit + 1+              foo_2 = foo_1 unit + 1.0           in foo_2  main = do-  f (foo 1)+  assert $ foo 1.0 == 2.0   trace "Done"

examples/passing/ShadowedTCO.purs view

@@ -1,6 +1,8 @@ module Main where -runNat f = f 0 (\n -> n + 1)+import Prelude++runNat f = f 0.0 (\n -> n + 1.0)  zero' z _ = z

examples/passing/ShadowedTCOLet.purs view

@@ -1,7 +1,9 @@ module Main where +import Prelude+ f x y z =-  let f 1 2 3 = 1+  let f 1.0 2.0 3.0 = 1.0   in f x z y -main = Debug.Trace.trace $ show $ f 1 3 2+main = Debug.Trace.trace $ show $ f 1.0 3.0 2.0

examples/passing/SignedNumericLiterals.purs view

@@ -1,15 +1,17 @@ module Main where -  p = 0.5-  q = 1-  x = -1-  y = -0.5-  z = 0.5-  w = 1+import Prelude -  f :: Number -> Number-  f x = -x+p = 0.5+q = 1.0+x = -1.0+y = -0.5+z = 0.5+w = 1.0 -  test1 = 2 - 1+f :: Number -> Number+f x = -x -  main = Debug.Trace.trace "Done"+test1 = 2.0 - 1.0++main = Debug.Trace.trace "Done"

examples/passing/Superclasses1.purs view

@@ -1,5 +1,7 @@ module Main where +import Prelude+ class Su a where   su :: a -> a @@ -7,7 +9,7 @@   cl :: a -> a -> a  instance suNumber :: Su Number where-  su n = n + 1+  su n = n + 1.0  instance clNumber :: Cl Number where   cl n m = n + m@@ -15,4 +17,4 @@ test :: forall a. (Cl a) => a -> a test a = su (cl a a) -main = Debug.Trace.print $ test 10+main = Debug.Trace.print $ test 10.0

examples/passing/Superclasses2.purs view

@@ -1,23 +1,24 @@ module Main where +import Prelude import Prelude.Unsafe (unsafeIndex)  class Su a where   su :: a -> a -class (Su [a]) <= Cl a where+class (Su (Array a)) <= Cl a where   cl :: a -> a -> a  instance suNumber :: Su Number where-  su n = n + 1+  su n = n + 1.0 -instance suArray :: (Su a) => Su [a] where-  su (x : _) = [su x]+instance suArray :: (Su a) => Su (Array a) where+  su [x] = [su x]  instance clNumber :: Cl Number where   cl n m = n + m -test :: forall a. (Cl a) => a -> [a]+test :: forall a. (Cl a) => a -> Array a test x = su [cl x x] -main = Debug.Trace.print $ test 10 `unsafeIndex` 0+main = Debug.Trace.print $ test 10.0 `unsafeIndex` 0.0

examples/passing/Superclasses3.purs view

@@ -1,14 +1,14 @@ module Main where +import Prelude import Debug.Trace- import Control.Monad.Eff  class (Monad m) <= MonadWriter w m where   tell :: w -> m Unit  testFunctor :: forall m. (Monad m) => m Number -> m Number-testFunctor n = (+) 1 <$> n+testFunctor n = (+) 1.0 <$> n  test :: forall w m. (Monad m, MonadWriter w m) => w -> m Unit test w = do@@ -31,7 +31,7 @@   pure = MTrace <<< return  instance bindMTrace :: Bind MTrace where-  (>>=) m f = MTrace (runMTrace m >>= (runMTrace <<< f))+  bind m f = MTrace (runMTrace m >>= (runMTrace <<< f))  instance monadMTrace :: Monad MTrace

examples/passing/TCOCase.purs view

@@ -1,10 +1,12 @@ module Main where +import Prelude+ data Data = One | More Data -main = Debug.Trace.trace (from (to 10000 One))+main = Debug.Trace.trace (from (to 10000.0 One))   where-  to 0 a = a-  to n a = to (n - 1) (More a)+  to 0.0 a = a+  to n a = to (n - 1.0) (More a)   from One = "Done"   from (More d) = from d

examples/passing/TailCall.purs view

@@ -2,14 +2,16 @@  import Prelude -test :: Number -> [Number] -> Number-test n [] = n-test n (x:xs) = test (n + x) xs+data L a = C a (L a) | N +test :: Number -> L Number -> Number+test n N = n+test n (C x xs) = test (n + x) xs+ loop :: forall a. Number -> a-loop x = loop (x + 1)+loop x = loop (x + 1.0)  notATailCall = \x ->   (\notATailCall -> notATailCall x) (\x -> x) -main = Debug.Trace.print (test 0 [1, 2, 3])+main = Debug.Trace.print (test 0.0 (1.0 `C` (2.0 `C` (3.0 `C` N))))

examples/passing/Tick.purs view

@@ -1,5 +1,7 @@ module Main where +import Prelude+ test' x = x  main = Debug.Trace.trace "Done"

examples/passing/TopLevelCase.purs view

@@ -1,18 +1,18 @@ module Main where -  import Prelude+import Prelude -  gcd :: Number -> Number -> Number-  gcd 0 x = x-  gcd x 0 = x-  gcd x y | x > y = gcd (x % y) y-  gcd x y = gcd (y % x) x+gcd :: Number -> Number -> Number+gcd 0.0 x = x+gcd x 0.0 = x+gcd x y | x > y = gcd (x % y) y+gcd x y = gcd (y % x) x -  guardsTest (x:xs) | x > 0 = guardsTest xs-  guardsTest xs = xs+guardsTest [x] | x > 0.0 = []+guardsTest xs = xs -  data A = A+data A = A -  parseTest A 0 = 0+parseTest A 0.0 = 0.0 -  main = Debug.Trace.trace "Done"+main = Debug.Trace.trace "Done"

− examples/passing/TypeClassImport.purs

@@ -1,18 +0,0 @@-module Main where--foreign import data T :: *--foreign import data C :: *--foreign import t "var t = null;" :: T--foreign import inst """-  var inst = {-    show: function(t) {-      return 'Done';-    }-  }""" :: C--foreign import instance inst :: Show T--main = Debug.Trace.print t

examples/passing/TypeClassMemberOrderChange.purs view

@@ -1,5 +1,7 @@ module Main where +import Prelude+ class Test a where   fn :: a -> a -> a   val :: a

examples/passing/TypeClasses.purs view

@@ -31,7 +31,7 @@   pure = Data  instance bindData :: Bind Data where-  (>>=) (Data a) f = f a+  bind (Data a) f = f a  instance monadData :: Monad Data @@ -47,23 +47,23 @@   pure = Just  instance bindMaybe :: Bind Maybe where-  (>>=) Nothing _ = Nothing-  (>>=) (Just a) f = f a+  bind Nothing _ = Nothing+  bind (Just a) f = f a  instance monadMaybe :: Monad Maybe  test4 :: forall a m. (Monad m) => a -> m Number-test4 = \_ -> return 1+test4 = \_ -> return 1.0 -test5 = \_ -> Just 1 >>= \n -> return (n + 1)+test5 = \_ -> Just 1.0 >>= \n -> return (n + 1.0)  ask r = r  runReader r f = f r -test9 _ = runReader 0 $ do+test9 _ = runReader 0.0 $ do   n <- ask-  return $ n + 1+  return $ n + 1.0  main = Debug.Trace.trace (test7 "Done")

examples/passing/TypeClassesWithOverlappingTypeVariables.purs view

@@ -1,11 +1,11 @@ module Main where -  import Prelude+import Prelude -  data Either a b = Left a | Right b+data Either a b = Left a | Right b -  instance functorEither :: Prelude.Functor (Either a) where-    (<$>) _ (Left x) = Left x-    (<$>) f (Right y) = Right (f y)+instance functorEither :: Prelude.Functor (Either a) where+  (<$>) _ (Left x) = Left x+  (<$>) f (Right y) = Right (f y) -  main = Debug.Trace.trace "Done"+main = Debug.Trace.trace "Done"

examples/passing/TypeDecl.purs view

@@ -1,12 +1,12 @@ module Main where -  import Prelude+import Prelude -  k :: String -> Number -> String-  k x y = x+k :: String -> Number -> String+k x y = x -  iterate :: forall a. Number -> (a -> a) -> a -> a-  iterate 0 f a = a-  iterate n f a = iterate (n - 1) f (f a)+iterate :: forall a. Number -> (a -> a) -> a -> a+iterate 0.0 f a = a+iterate n f a = iterate (n - 1.0) f (f a) -  main = Debug.Trace.trace "Done"+main = Debug.Trace.trace "Done"

examples/passing/TypeSynonymInData.purs view

@@ -1,6 +1,8 @@ module Main where -type A a = [a]+import Prelude++type A a = Array a  data Foo a = Foo (A a) | Bar

examples/passing/TypeSynonyms.purs view

@@ -1,25 +1,27 @@ module Main where -  type Lens a b =-    { get :: a -> b-    , set :: a -> b -> a-    }+import Prelude -  composeLenses :: forall a b c. Lens a b -> Lens b c -> Lens a c-  composeLenses = \l1 -> \l2 ->-    { get: \a -> l2.get (l1.get a)-    , set: \a c -> l1.set a (l2.set (l1.get a) c)-    }+type Lens a b =+  { get :: a -> b+  , set :: a -> b -> a+  } -  type Pair a b = { fst :: a, snd :: b }+composeLenses :: forall a b c. Lens a b -> Lens b c -> Lens a c+composeLenses = \l1 -> \l2 ->+  { get: \a -> l2.get (l1.get a)+  , set: \a c -> l1.set a (l2.set (l1.get a) c)+  } -  fst :: forall a b. Lens (Pair a b) a-  fst =-    { get: \p -> p.fst-    , set: \p a -> { fst: a, snd: p.snd }-    }+type Pair a b = { fst :: a, snd :: b } -  test1 :: forall a b c. Lens (Pair (Pair a b) c) a-  test1 = composeLenses fst fst+fst :: forall a b. Lens (Pair a b) a+fst =+  { get: \p -> p.fst+  , set: \p a -> { fst: a, snd: p.snd }+  } -  main = Debug.Trace.trace "Done"+test1 :: forall a b c. Lens (Pair (Pair a b) c) a+test1 = composeLenses fst fst++main = Debug.Trace.trace "Done"

examples/passing/TypeWildcards.purs view

@@ -1,7 +1,9 @@ module Main where +import Prelude+ testTopLevel :: _ -> _-testTopLevel n = n + 1+testTopLevel n = n + 1.0  test :: forall a. (Eq a) => (a -> a) -> a -> a test f a = go (f a) a

examples/passing/TypeWildcardsRecordExtension.purs view

@@ -1,5 +1,7 @@ module Main where +import Prelude+ foo :: forall a. {b :: Number | a} -> {b :: Number | _} foo f = f

examples/passing/TypedWhere.purs view

@@ -1,13 +1,17 @@ module Main where +import Prelude+ data E a b = L a | R b -lefts :: forall a b. [E a b] -> [a]-lefts = go []+data L a = C a (L a) | N++lefts :: forall a b. L (E a b) -> L a+lefts = go N   where-  go :: forall a b. [a] -> [E a b] -> [a]-  go ls [] = ls-  go ls (L a : rest) = go (a : ls) rest-  go ls (_ : rest) = go ls rest+  go :: forall a b. L a -> L (E a b) -> L a+  go ls N = ls+  go ls (C (L a) rest) = go (C a ls) rest+  go ls (C _ rest) = go ls rest  main = Debug.Trace.trace "Done"

examples/passing/UnderscoreIdent.purs view

@@ -1,5 +1,7 @@ module Main where +import Prelude+ data Data_type = Con_Structor | Con_2 String  type Type_name = Data_type

examples/passing/UnknownInTypeClassLookup.purs view

@@ -1,5 +1,7 @@ module Main where +import Prelude+ class EQ a b  instance eqAA :: EQ a a@@ -9,4 +11,4 @@  runTest a = test a a -main = Debug.Trace.trace $ runTest 0+main = Debug.Trace.trace $ runTest 0.0

examples/passing/Where.purs view

@@ -7,29 +7,29 @@ test1 x = y   where   y :: Number-  y = x + 1+  y = x + 1.0  test2 x y = x' + y'   where-  x' = x + 1-  y' = y + 1+  x' = x + 1.0+  y' = y + 1.0  -test3 = f 1 2 3+test3 = f 1.0 2.0 3.0   where f x y z = x + y + z  -test4 = f (+) [1, 2]+test4 = f (+) [1.0, 2.0]   where f x [y, z] = x y z  -test5 = g 10+test5 = g 10.0   where-  f x | x > 0 = g (x / 2) + 1-  f x = 0-  g x = f (x - 1) + 1+  f x | x > 0.0 = g (x / 2.0) + 1.0+  f x = 0.0+  g x = f (x - 1.0) + 1.0 -test6 = if f true then f 1 else f 2+test6 = if f true then f 1.0 else f 2.0   where f :: forall a. a -> a         f x = x @@ -37,13 +37,13 @@ test7 x = go x   where   go y | (x - 0.1 < y * y) && (y * y < x + 0.1) = y-  go y = go $ (y + x / y) / 2+  go y = go $ (y + x / y) / 2.0  main = do-  Debug.Trace.print (test1 1)-  Debug.Trace.print (test2 1 2)+  Debug.Trace.print (test1 1.0)+  Debug.Trace.print (test2 1.0 2.0)   Debug.Trace.print test3   Debug.Trace.print test4   Debug.Trace.print test5   Debug.Trace.print test6-  Debug.Trace.print (test7 100)+  Debug.Trace.print (test7 100.0)

examples/passing/iota.purs view

@@ -1,9 +1,9 @@ module Main where -  s = \x -> \y -> \z -> x z (y z)+s = \x -> \y -> \z -> x z (y z) -  k = \x -> \y -> x+k = \x -> \y -> x -  iota = \x -> x s k+iota = \x -> x s k -  main = Debug.Trace.trace "Done"+main = Debug.Trace.trace "Done"

examples/passing/s.purs view

@@ -1,5 +1,7 @@ module Main where -  s = \x y z -> x z (y z)+import Prelude -  main = Debug.Trace.trace "Done"+s = \x y z -> x z (y z)++main = Debug.Trace.trace "Done"

hierarchy/Main.hs view

@@ -13,6 +13,8 @@ -- ----------------------------------------------------------------------------- +{-# LANGUAGE TupleSections #-}+ module Main where  import Control.Monad (unless)@@ -24,15 +26,13 @@ import Options.Applicative import System.Directory (createDirectoryIfMissing) import System.FilePath ((</>))+import System.FilePath.Glob (glob) import System.Exit (exitFailure, exitSuccess) import System.IO (hPutStr, stderr) -import Text.Parsec as Par (ParseError)- import qualified Language.PureScript as P import qualified Paths_purescript as Paths - data HierarchyOptions = HierarchyOptions   { hierachyInput   :: FilePath   , hierarchyOutput :: Maybe FilePath@@ -53,16 +53,17 @@ runModuleName :: P.ModuleName -> String runModuleName (P.ModuleName pns) = intercalate "_" (P.runProperName `map` pns) -readInput :: FilePath -> IO (Either Par.ParseError [P.Module])-readInput filename = do-  content <- readFile filename-  return $ fmap (map snd) $ P.parseModulesFromFiles id [(filename, content)]+readInput :: [FilePath] -> IO (Either P.MultipleErrors [P.Module])+readInput paths = do+  content <- mapM (\path -> (path, ) <$> readFile path) paths+  return $ map snd <$> P.parseModulesFromFiles id content  compile :: HierarchyOptions -> IO ()-compile (HierarchyOptions input mOutput) = do+compile (HierarchyOptions inputGlob mOutput) = do+  input <- glob inputGlob   modules <- readInput input   case modules of-    Left err -> hPutStr stderr (show err) >> exitFailure+    Left errs -> hPutStr stderr (P.prettyPrintMultipleErrors False errs) >> exitFailure     Right ms -> do       for_ ms $ \(P.Module _ moduleName decls _) ->         let name = runModuleName moduleName

− prelude/prelude.purs

@@ -1,1478 +0,0 @@-module Prelude-  ( otherwise-  , flip-  , const-  , asTypeOf-  , Semigroupoid, (<<<), (>>>)-  , Category, id-  , ($), (#)-  , (:), cons-  , Show, show-  , Functor, (<$>), (<#>), void-  , Apply, (<*>)-  , Applicative, pure, liftA1-  , Bind, (>>=)-  , Monad, return, liftM1, ap-  , Semiring, (+), zero, (*), one-  , ModuloSemiring, (/), mod-  , Ring, (-)-  , (%)-  , negate-  , DivisionRing-  , Num-  , Eq, (==), (/=)-  , Ord, Ordering(..), compare, (<), (>), (<=), (>=)-  , Bits, (.&.), (.|.), (.^.), shl, shr, zshr, complement-  , BoolLike, (&&), (||)-  , not-  , Semigroup, (<>), (++)-  , Unit(..), unit-  ) where--  -- | An alias for `true`, which can be useful in guard clauses:-  -- |-  -- | ```purescript-  -- | max x y | x >= y = x-  -- |         | otherwise = y-  -- | ```-  -- |-  otherwise :: Boolean-  otherwise = true--  -- | Flips the order of the arguments to a function of two arguments.-  -- |-  -- | ```purescript-  -- | flip const 1 2 = const 2 1 = 2-  -- | ```-  -- |-  flip :: forall a b c. (a -> b -> c) -> b -> a -> c-  flip f b a = f a b--  -- | Returns its first argument and ignores its second.-  -- |-  -- | ```purescript-  -- | const 1 "hello" = 1-  -- | ```-  -- |-  const :: forall a b. a -> b -> a-  const a _ = a--  -- | This function returns its first argument, and can be used to assert type equalities.-  -- | This can be useful when types are otherwise ambiguous.-  -- |-  -- | ```purescript-  -- | main = print $ [] `asTypeOf` [0]-  -- | ```-  -- |-  -- | If instead, we had written `main = print []`, the type of the argument `[]` would have-  -- | been ambiguous, resulting in a compile-time error.-  asTypeOf :: forall a. a -> a -> a-  asTypeOf x _ = x--  infixr 9 >>>-  infixr 9 <<<--  -- | A `Semigroupoid` is similar to a [`Category`](#category) but does not require an identity-  -- | element `id`, just composable morphisms.-  -- |-  -- | `Semigroupoid`s should obey the following rule:-  -- |-  -- | - Associativity: `p <<< (q <<< r) = (p <<< q) <<< r`-  -- |-  -- | One example of a `Semigroupoid` is the function type constructor `(->)`, with `(<<<)` defined-  -- | as function composition.-  class Semigroupoid a where-    (<<<) :: forall b c d. a c d -> a b c -> a b d--  instance semigroupoidArr :: Semigroupoid (->) where-    (<<<) f g x = f (g x)--  -- | Forwards composition, or `(<<<)` with its arguments reversed.-  (>>>) :: forall a b c d. (Semigroupoid a) => a b c -> a c d -> a b d-  (>>>) f g = g <<< f--  -- | `Category`s consist of objects and composable morphisms between them, and as such are-  -- | [`Semigroupoids`](#semigroupoid), but unlike `semigroupoids` must have an identity element.-  -- |-  -- | `Category`s should obey the following rules.-  -- |-  -- | - Left Identity: `id <<< p = p`-  -- | - Right Identity: `p <<< id = p`-  -- |-  class (Semigroupoid a) <= Category a where-    id :: forall t. a t t--  instance categoryArr :: Category (->) where-    id x = x--  infixr 0 $-  infixl 0 #--  -- | Applies a function to its argument-  -- |-  -- | ```purescript-  -- | length $ groupBy productCategory $ filter isInStock products-  -- | ```-  -- |-  -- | is equivalent to-  -- |-  -- | ```purescript-  -- | length (groupBy productCategory (filter isInStock (products)))-  -- | ```-  -- |-  -- | `($)` is different from [`(#)`](#-2) because it is right-infix instead of left, so-  -- | `a $ b $ c $ d x` = `a $ (b $ (c $ (d $ x)))` = `a (b (c (d x)))`-  -- |-  ($) :: forall a b. (a -> b) -> a -> b-  ($) f x = f x--  -- | Applies a function to its argument-  -- |-  -- | ```purescript-  -- | products # groupBy productCategory # filter isInStock # length-  -- | ```-  -- |-  -- | is equivalent to-  -- |-  -- | ```purescript-  -- | length (groupBy productCategory (filter isInStock (products)))-  -- | ```-  -- |-  -- | `(#)` is different from [`($)`](#-1) because it is left-infix instead of right, so-  -- | `x # a # b # c # d` = `(((x # a) # b) # c) # d` = `d (c (b (a x)))`-  -- |-  (#) :: forall a b. a -> (a -> b) -> b-  (#) x f = f x--  infixr 6 :--  -- | An infix alias for `cons`.-  -- |-  -- | Note, the running time of this function is `O(n)`.-  (:) :: forall a. a -> [a] -> [a]-  (:) = cons--  -- | Attaches an element to the front of an array, creating a new array.-  -- |-  -- | ```purescript-  -- | cons 1 [2, 3, 4] = [1, 2, 3, 4]-  -- | ```-  -- |-  -- | Note, the running time of this function is `O(n)`.-  foreign import cons-    """-    function cons(e) {-      return function(l) {-        return [e].concat(l);-      };-    }-    """ :: forall a. a -> [a] -> [a]--  -- | The `Show` type class represents those types which can be converted into a human-readable `String` representation.-  -- |-  -- | While not required, it is recommended that for any expression `x`, the string `show x` be executable PureScript code-  -- | which evaluates to the same value as the expression `x`.-  class Show a where-    show :: a -> String--  foreign import showStringImpl-    """-    function showStringImpl(s) {-      return JSON.stringify(s);-    }-    """ :: String -> String--  instance showUnit :: Show Unit where-    show (Unit {}) = "Unit {}"--  instance showString :: Show String where-    show = showStringImpl--  instance showBoolean :: Show Boolean where-    show true = "true"-    show false = "false"--  foreign import showNumberImpl-    """-    function showNumberImpl(n) {-      return n.toString();-    }-    """ :: Number -> String--  instance showNumber :: Show Number where-    show = showNumberImpl--  foreign import showArrayImpl-    """-    function showArrayImpl(f) {-      return function(xs) {-        var ss = [];-        for (var i = 0, l = xs.length; i < l; i++) {-          ss[i] = f(xs[i]);-        }-        return '[' + ss.join(',') + ']';-      };-    }-    """ :: forall a. (a -> String) -> [a] -> String--  instance showArray :: (Show a) => Show [a] where-    show = showArrayImpl show--  infixl 4 <$>-  infixl 1 <#>--  -- | A `Functor` is a type constructor which supports a mapping operation `(<$>)`.-  -- |-  -- | `(<$>)` can be used to turn functions `a -> b` into functions `f a -> f b` whose argument and return-  -- | types use the type constructor `f` to represent some computational context.-  -- |-  -- | `Functor` instances should satisfy the following laws:-  -- |-  -- | - Identity: `(<$>) id = id`-  -- | - Composition: `(<$>) (f <<< g) = (f <$>) <<< (g <$>)`-  -- |-  class Functor f where-    (<$>) :: forall a b. (a -> b) -> f a -> f b--  -- | `(<#>)` is `(<$>)` with its arguments reversed. For example:-  -- |-  -- | ```purescript-  -- | [1, 2, 3] <#> \n -> n * n-  -- | ```-  (<#>) :: forall f a b. (Functor f) => f a -> (a -> b) -> f b-  (<#>) fa f = f <$> fa--  -- | The `void` function is used to ignore the type wrapped by a [`Functor`](#functor), replacing it with `Unit` and-  -- | keeping only the type information provided by the type constructor itself.-  -- |-  -- | `void` is often useful when using `do` notation to change the return type of a monadic computation:-  -- |-  -- | ```purescript-  -- | main = forE 1 10 \n -> void do-  -- |   print n-  -- |   print (n * n)-  -- | ```-  void :: forall f a. (Functor f) => f a -> f Unit-  void fa = const unit <$> fa--  infixl 4 <*>--  -- | The `Apply` class provides the `(<*>)` which is used to apply a function to an argument under a type constructor.-  -- |-  -- | `Apply` can be used to lift functions of two or more arguments to work on values wrapped with the type constructor `f`.-  -- | It might also be understood in terms of the `lift2` function:-  -- |-  -- | ```purescript-  -- | lift2 :: forall f a b c. (Apply f) => (a -> b -> c) -> f a -> f b -> f c-  -- | lift2 f a b = f <$> a <*> b-  -- | ```-  -- |-  -- | `(<*>)` is recovered from `lift2` as `lift2 ($)`. That is, `(<*>)` lifts the function application operator `($)` to arguments-  -- | wrapped with the type constructor `f`.-  -- |-  -- | `Apply` instances should satisfy the following law:-  -- |-  -- | - Associative Composition: `(<<<) <$> f <*> g <*> h = f <*> (g <*> h)`-  -- |-  -- | Formally, `Apply` represents a strong lax semi-monoidal endofunctor.-  class (Functor f) <= Apply f where-    (<*>) :: forall a b. f (a -> b) -> f a -> f b--  -- | The `Applicative` type class extends the [`Apply`](#apply) type class with a `pure` function, which can be used to-  -- | create values of type `f a` from values of type `a`.-  -- |-  -- | Where [`Apply`](#apply) provides the ability to lift functions of two or more arguments to functions whose arguments are wrapped using `f`,-  -- | and [`Functor`](#functor) provides the ability to lift functions of one argument, `pure` can be seen as the function which lifts functions of-  -- | _zero_ arguments. That is, `Applicative` functors support a lifting operation for any number of function arguments.-  -- |-  -- | `Applicative` instances should satisfy the following laws:-  -- |-  -- | - Identity: `(pure id) <*> v = v`-  -- | - Composition: `(pure <<<) <*> f <*> g <*> h = f <*> (g <*> h)`-  -- | - Homomorphism: `(pure f) <*> (pure x) = pure (f x)`-  -- | - Interchange: `u <*> (pure y) = (pure ($ y)) <*> u`-  -- |-  class (Apply f) <= Applicative f where-    pure :: forall a. a -> f a--  -- | `liftA1` provides a default implementation of `(<$>)` for any [`Applicative`](#applicative) functor,-  -- | without using `(<$>)` as provided by the [`Functor`](#functor)-[`Applicative`](#applicative) superclass relationship.-  -- |-  -- | `liftA1` can therefore be used to write [`Functor`](#functor) instances as follows:-  -- |-  -- | ```purescript-  -- | instance functorF :: Functor F where-  -- |   (<$>) = liftA1-  -- | ```-  liftA1 :: forall f a b. (Applicative f) => (a -> b) -> f a -> f b-  liftA1 f a = pure f <*> a--  infixl 1 >>=--  -- | The `Bind` type class extends the [`Apply`](#apply) type class with a "bind" operation `(>>=)` which composes computations-  -- | in sequence, using the return value of one computation to determine the next computation.-  -- |-  -- | The `>>=` operator can also be expressed using `do` notation, as follows:-  -- |-  -- | ```purescript-  -- | x >>= f = do y <- x-  -- |              f y-  -- | ```-  -- |-  -- | where the function argument of `f` is given the name `y`.-  -- |-  -- | `Bind` instances should satisfy the following law:-  -- |-  -- | - Associativity: `(x >>= f) >>= g = x >>= (\k => f k >>= g)`-  -- |-  -- | Or, expressed using `do` notation:-  -- |-  -- | - Associativity: `do { z <- do { y <- x ; f y } ; g z } = do { k <- x ; do { y <- f k ; g y } }`-  -- |-  -- | Associativity tells us that we can regroup operations which use do-notation, so that we can unambiguously write, for example:-  -- |-  -- | ```purescript-  -- | do x <- m1-  -- |    y <- m2 x-  -- |    m3 x y-  -- | ```-  class (Apply m) <= Bind m where-    (>>=) :: forall a b. m a -> (a -> m b) -> m b--  -- | The `Monad` type class combines the operations of the `Bind` and `Applicative` type classes. Therefore, `Monad` instances-  -- | represent type constructors which support sequential composition, and also lifting of functions of arbitrary arity.-  -- |-  -- | `Monad` instances should satisfy the following laws:-  -- |-  -- | - Left Identity: `pure x >>= f = f x`-  -- | - Right Identity: `x >>= pure = x`-  -- |-  -- | Or, expressed using `do` notation:-  -- |-  -- | - Left Identity: `do { y <- pure x ; f y } = f x`-  -- | - Right Identity: `do { y <- x ; pure y } = x`-  -- |-  class (Applicative m, Bind m) <= Monad m--  -- | `return` is an alias for `pure`.-  return :: forall m a. (Monad m) => a -> m a-  return = pure--  -- | `liftM1` provides a default implementation of `(<$>)` for any [`Monad`](#monad),-  -- | without using `(<$>)` as provided by the [`Functor`](#functor)-[`Monad`](#monad) superclass relationship.-  -- |-  -- | `liftM1` can therefore be used to write [`Functor`](#functor) instances as follows:-  -- |-  -- | ```purescript-  -- | instance functorF :: Functor F where-  -- |   (<$>) = liftM1-  -- | ```-  liftM1 :: forall m a b. (Monad m) => (a -> b) -> m a -> m b-  liftM1 f a = do-    a' <- a-    return (f a')--  -- | `ap` provides a default implementation of `(<*>)` for any [`Monad`](#monad),-  -- | without using `(<*>)` as provided by the [`Apply`](#apply)-[`Monad`](#monad) superclass relationship.-  -- |-  -- | `ap` can therefore be used to write [`Apply`](#apply) instances as follows:-  -- |-  -- | ```purescript-  -- | instance applyF :: Apply F where-  -- |   (<*>) = ap-  -- | ```-  ap :: forall m a b. (Monad m) => m (a -> b) -> m a -> m b-  ap f a = do-    f' <- f-    a' <- a-    return (f' a')--  instance functorArr :: Functor ((->) r) where-    (<$>) = (<<<)--  instance applyArr :: Apply ((->) r) where-    (<*>) f g x = f x (g x)--  instance applicativeArr :: Applicative ((->) r) where-    pure = const--  instance bindArr :: Bind ((->) r) where-    (>>=) m f x = f (m x) x--  instance monadArr :: Monad ((->) r)--  infixl 7 *-  infixl 7 /-  infixl 7 %--  infixl 6 --  infixl 6 +--  -- | Addition and multiplication, satisfying the following laws:-  -- |-  -- | - `a` is a commutative monoid under addition-  -- | - `a` is a monoid under multiplication-  -- | - multiplication distributes over addition-  -- | - multiplication by `zero` annihilates `a`-  -- |-  class Semiring a where-    (+)  :: a -> a -> a-    zero :: a-    (*)  :: a -> a -> a-    one  :: a--  -- | Addition, multiplication, modulo operation and division, satisfying:-  -- |-  -- | - ```a / b * b + (a `mod` b) = a```-  -- |-  class (Semiring a) <= ModuloSemiring a where-    (/) :: a -> a -> a-    mod :: a -> a -> a--  -- | Addition, multiplication, and subtraction.-  -- |-  -- | Has the same laws as `Semiring` but additionally satisfying:-  -- |-  -- | - `a` is an abelian group under addition-  -- |-  class (Semiring a) <= Ring a where-    (-) :: a -> a -> a--  negate :: forall a. (Ring a) => a -> a-  negate a = zero - a--  -- | Ring where every nonzero element has a multiplicative inverse so that:-  -- |-  -- | - ```a `mod` b = zero```-  -- |-  class (Ring a, ModuloSemiring a) <= DivisionRing a--  -- | A commutative field-  class (DivisionRing a) <= Num a--  foreign import numAdd-    """-    function numAdd(n1) {-      return function(n2) {-        return n1 + n2;-      };-    }-    """ :: Number -> Number -> Number--  foreign import numSub-    """-    function numSub(n1) {-      return function(n2) {-        return n1 - n2;-      };-    }-    """ :: Number -> Number -> Number--  foreign import numMul-    """-    function numMul(n1) {-      return function(n2) {-        return n1 * n2;-      };-    }-    """ :: Number -> Number -> Number--  foreign import numDiv-    """-    function numDiv(n1) {-      return function(n2) {-        return n1 / n2;-      };-    }-    """ :: Number -> Number -> Number--  foreign import numMod-    """-    function numMod(n1) {-      return function(n2) {-        return n1 % n2;-      };-    }-    """ :: Number -> Number -> Number--  (%) = numMod--  instance semiringNumber :: Semiring Number where-    (+) = numAdd-    zero = 0-    (*) = numMul-    one = 1--  instance ringNumber :: Ring Number where-    (-) = numSub--  instance moduloSemiringNumber :: ModuloSemiring Number where-    (/) = numDiv-    mod _ _ = 0--  instance divisionRingNumber :: DivisionRing Number--  instance numNumber :: Num Number--  -- | The `Unit` type has a single inhabitant, called `unit`. It represents values with no computational content.-  -- |-  -- | `Unit` is often used, wrapped in a monadic type constructor, as the return type of a computation where only-  -- | the _effects_ are important.-  newtype Unit = Unit {}--  -- | `unit` is the sole inhabitant of the `Unit` type.-  unit :: Unit-  unit = Unit {}--  infix 4 ==-  infix 4 /=--  -- | The `Eq` type class represents types which support decidable equality.-  -- |-  -- | `Eq` instances should satisfy the following laws:-  -- |-  -- | - Reflexivity: `x == x = true`-  -- | - Symmetry: `x == y = y == x`-  -- | - Transitivity: if `x == y` and `y == z` then `x == z`-  -- | - Negation: `x /= y = not (x == y)`-  -- |-  -- | `(/=)` may be implemented in terms of `(==)`, but it might give a performance improvement to implement it separately.-  class Eq a where-    (==) :: a -> a -> Boolean-    (/=) :: a -> a -> Boolean--  foreign import refEq-    """-    function refEq(r1) {-      return function(r2) {-        return r1 === r2;-      };-    }-    """ :: forall a. a -> a -> Boolean--  foreign import refIneq-    """-    function refIneq(r1) {-      return function(r2) {-        return r1 !== r2;-      };-    }-    """ :: forall a. a -> a -> Boolean--  instance eqUnit :: Eq Unit where-    (==) (Unit {}) (Unit {}) = true-    (/=) (Unit {}) (Unit {}) = false--  instance eqString :: Eq String where-    (==) = refEq-    (/=) = refIneq--  instance eqNumber :: Eq Number where-    (==) = refEq-    (/=) = refIneq--  instance eqBoolean :: Eq Boolean where-    (==) = refEq-    (/=) = refIneq--  foreign import eqArrayImpl-    """-    function eqArrayImpl(f) {-      return function(xs) {-        return function(ys) {-          if (xs.length !== ys.length) return false;-          for (var i = 0; i < xs.length; i++) {-            if (!f(xs[i])(ys[i])) return false;-          }-          return true;-        };-      };-    }-    """ :: forall a. (a -> a -> Boolean) -> [a] -> [a] -> Boolean--  instance eqArray :: (Eq a) => Eq [a] where-    (==) xs ys = eqArrayImpl (==) xs ys-    (/=) xs ys = not (xs == ys)--  -- | The `Ordering` data type represents the three possible outcomes of comparing two values:-  -- |-  -- | `LT` - The first value is _less than_ the second.-  -- | `GT` - The first value is _greater than_ the second.-  -- | `EQ` - The first value is _equal to_ or _incomparable to_ the second.-  data Ordering = LT | GT | EQ--  instance eqOrdering :: Eq Ordering where-    (==) LT LT = true-    (==) GT GT = true-    (==) EQ EQ = true-    (==) _  _  = false-    (/=) x y = not (x == y)--  instance showOrdering :: Show Ordering where-    show LT = "LT"-    show GT = "GT"-    show EQ = "EQ"--  instance semigroupOrdering :: Semigroup Ordering where-    (<>) LT _ = LT-    (<>) GT _ = GT-    (<>) EQ y = y--  -- | The `Ord` type class represents types which support comparisons.-  -- |-  -- | `Ord` instances should satisfy the laws of _partially orderings_:-  -- |-  -- | - Reflexivity: `a <= a`-  -- | - Antisymmetry: if `a <= b` and `b <= a` then `a = b`-  -- | - Transitivity: if `a <= b` and `b <= c` then `a <= c`-  -- |-  class (Eq a) <= Ord a where-    compare :: a -> a -> Ordering--  infixl 4 <--  -- | Test whether one value is _strictly less than_ another.-  (<) :: forall a. (Ord a) => a -> a -> Boolean-  (<) a1 a2 = case a1 `compare` a2 of-    LT -> true-    _ -> false--  infixl 4 >--  -- | Test whether one value is _strictly greater than_ another.-  (>) :: forall a. (Ord a) => a -> a -> Boolean-  (>) a1 a2 = case a1 `compare` a2 of-    GT -> true-    _ -> false--  infixl 4 <=--  -- | Test whether one value is _non-strictly less than_ another.-  (<=) :: forall a. (Ord a) => a -> a -> Boolean-  (<=) a1 a2 = case a1 `compare` a2 of-    GT -> false-    _ -> true--  infixl 4 >=--  -- | Test whether one value is _non-strictly greater than_ another.-  (>=) :: forall a. (Ord a) => a -> a -> Boolean-  (>=) a1 a2 = case a1 `compare` a2 of-    LT -> false-    _ -> true--  foreign import unsafeCompareImpl-    """-    function unsafeCompareImpl(lt) {-      return function(eq) {-        return function(gt) {-          return function(x) {-            return function(y) {-              return x < y ? lt : x > y ? gt : eq;-            };-          };-        };-      };-    }-    """ :: forall a. Ordering -> Ordering -> Ordering -> a -> a -> Ordering--  unsafeCompare :: forall a. a -> a -> Ordering-  unsafeCompare = unsafeCompareImpl LT EQ GT--  instance ordUnit :: Ord Unit where-    compare (Unit {}) (Unit {}) = EQ--  instance ordBoolean :: Ord Boolean where-    compare false false = EQ-    compare false true  = LT-    compare true  true  = EQ-    compare true  false = GT--  instance ordNumber :: Ord Number where-    compare = unsafeCompare--  instance ordString :: Ord String where-    compare = unsafeCompare--  instance ordArray :: (Ord a) => Ord [a] where-    compare [] [] = EQ-    compare [] _ = LT-    compare _ [] = GT-    compare (x:xs) (y:ys) = case compare x y of-      EQ -> compare xs ys-      other -> other--  infixl 10 .&.-  infixl 10 .|.-  infixl 10 .^.--  -- | The `Bits` type class identifies types which support bitwise operations.-  class Bits b where-    (.&.) :: b -> b -> b-    (.|.) :: b -> b -> b-    (.^.) :: b -> b -> b-    shl :: b -> Number -> b-    shr :: b -> Number -> b-    zshr :: b -> Number -> b-    complement :: b -> b--  foreign import numShl-    """-    function numShl(n1) {-      return function(n2) {-        return n1 << n2;-      };-    }-    """ :: Number -> Number -> Number--  foreign import numShr-    """-    function numShr(n1) {-      return function(n2) {-        return n1 >> n2;-      };-    }-    """ :: Number -> Number -> Number--  foreign import numZshr-    """-    function numZshr(n1) {-      return function(n2) {-        return n1 >>> n2;-      };-    }-    """ :: Number -> Number -> Number--  foreign import numAnd-    """-    function numAnd(n1) {-      return function(n2) {-        return n1 & n2;-      };-    }-    """ :: Number -> Number -> Number--  foreign import numOr-    """-    function numOr(n1) {-      return function(n2) {-        return n1 | n2;-      };-    }-    """ :: Number -> Number -> Number--  foreign import numXor-    """-    function numXor(n1) {-      return function(n2) {-        return n1 ^ n2;-      };-    }-    """ :: Number -> Number -> Number--  foreign import numComplement-    """-    function numComplement(n) {-      return ~n;-    }-    """ :: Number -> Number--  instance bitsNumber :: Bits Number where-    (.&.) = numAnd-    (.|.) = numOr-    (.^.) = numXor-    shl = numShl-    shr = numShr-    zshr = numZshr-    complement = numComplement--  infixr 2 ||-  infixr 3 &&--  -- | The `BoolLike` type class identifies types which support Boolean operations.-  -- |-  -- | `BoolLike` instances are required to satisfy the laws of a _Boolean algebra_.-  -- |-  class BoolLike b where-    (&&) :: b -> b -> b-    (||) :: b -> b -> b-    not :: b -> b--  foreign import boolAnd-    """-    function boolAnd(b1) {-      return function(b2) {-        return b1 && b2;-      };-    }-    """  :: Boolean -> Boolean -> Boolean--  foreign import boolOr-    """-    function boolOr(b1) {-      return function(b2) {-        return b1 || b2;-      };-    }-    """ :: Boolean -> Boolean -> Boolean--  foreign import boolNot-    """-    function boolNot(b) {-      return !b;-    }-    """ :: Boolean -> Boolean--  instance boolLikeBoolean :: BoolLike Boolean where-    (&&) = boolAnd-    (||) = boolOr-    not = boolNot--  infixr 5 <>--  -- | The `Semigroup` type class identifies an associative operation on a type.-  -- |-  -- | `Semigroup` instances are required to satisfy the following law:-  -- |-  -- | - Associativity: `(x <> y) <> z = x <> (y <> z)`-  -- |-  -- | For example, the `String` type is an instance of `Semigroup`, where `(<>)` is defined to be string concatenation.-  class Semigroup a where-    (<>) :: a -> a -> a--  foreign import concatString-    """-    function concatString(s1) {-      return function(s2) {-        return s1 + s2;-      };-    }-    """ :: String -> String -> String--  instance semigroupUnit :: Semigroup Unit where-    (<>) (Unit {}) (Unit {}) = Unit {}--  instance semigroupString :: Semigroup String where-    (<>) = concatString--  instance semigroupArr :: (Semigroup s') => Semigroup (s -> s') where-    (<>) f g = \x -> f x <> g x--  infixr 5 ++--  -- | `(++)` is an alias for `(<>)`.-  (++) :: forall s. (Semigroup s) => s -> s -> s-  (++) = (<>)--module Data.Function where--  -- | The `on` function is used to change the domain of a binary operator.-  -- |-  -- | For example, we can create a function which compares two records based on the values of their `x` properties:-  -- |-  -- | ```purescript-  -- | compareX :: forall r. { x :: Number | r } -> { x :: Number | r } -> Ordering-  -- | compareX = compare `on` _.x-  -- | ```-  on :: forall a b c. (b -> b -> c) -> (a -> b) -> a -> a -> c-  on f g x y = g x `f` g y--  -- | A function of zero arguments-  foreign import data Fn0 :: * -> *--  -- | A function of one argument-  foreign import data Fn1 :: * -> * -> *--  -- | A function of two arguments-  foreign import data Fn2 :: * -> * -> * -> *--  -- | A function of three arguments-  foreign import data Fn3 :: * -> * -> * -> * -> *--  -- | A function of four arguments-  foreign import data Fn4 :: * -> * -> * -> * -> * -> *--  -- | A function of five arguments-  foreign import data Fn5 :: * -> * -> * -> * -> * -> * -> *--  -- | A function of six arguments-  foreign import data Fn6 :: * -> * -> * -> * -> * -> * -> * -> *--  -- | A function of seven arguments-  foreign import data Fn7 :: * -> * -> * -> * -> * -> * -> * -> * -> *--  -- | A function of eight arguments-  foreign import data Fn8 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> *--  -- | A function of nine arguments-  foreign import data Fn9 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *--  -- | A function of ten arguments-  foreign import data Fn10 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *--  -- | Create a function of no arguments-  foreign import mkFn0-    """-    function mkFn0(fn) {-      return function() {-        return fn({});-      };-    }-    """ :: forall a. (Unit -> a) -> Fn0 a--  -- | Create a function of one argument-  foreign import mkFn1-    """-    function mkFn1(fn) {-      return function(a) {-        return fn(a);-      };-    }-    """ :: forall a b. (a -> b) -> Fn1 a b--  -- | Create a function of two arguments from a curried function-  foreign import mkFn2-    """-    function mkFn2(fn) {-      return function(a, b) {-        return fn(a)(b);-      };-    }-    """ :: forall a b c. (a -> b -> c) -> Fn2 a b c--  -- | Create a function of three arguments from a curried function-  foreign import mkFn3-    """-    function mkFn3(fn) {-      return function(a, b, c) {-        return fn(a)(b)(c);-      };-    }-    """ :: forall a b c d. (a -> b -> c -> d) -> Fn3 a b c d--  -- | Create a function of four arguments from a curried function-  foreign import mkFn4-    """-    function mkFn4(fn) {-      return function(a, b, c, d) {-        return fn(a)(b)(c)(d);-      };-    }-    """ :: forall a b c d e. (a -> b -> c -> d -> e) -> Fn4 a b c d e--  -- | Create a function of five arguments from a curried function-  foreign import mkFn5-    """-    function mkFn5(fn) {-      return function(a, b, c, d, e) {-        return fn(a)(b)(c)(d)(e);-      };-    }-    """ :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> Fn5 a b c d e f--  -- | Create a function of six arguments from a curried function-  foreign import mkFn6-    """-    function mkFn6(fn) {-      return function(a, b, c, d, e, f) {-        return fn(a)(b)(c)(d)(e)(f);-      };-    }-    """ :: forall a b c d e f g. (a -> b -> c -> d -> e -> f -> g) -> Fn6 a b c d e f g--  -- | Create a function of seven arguments from a curried function-  foreign import mkFn7-    """-    function mkFn7(fn) {-      return function(a, b, c, d, e, f, g) {-        return fn(a)(b)(c)(d)(e)(f)(g);-      };-    }-    """ :: forall a b c d e f g h. (a -> b -> c -> d -> e -> f -> g -> h) -> Fn7 a b c d e f g h--  -- | Create a function of eight arguments from a curried function-  foreign import mkFn8-    """-    function mkFn8(fn) {-      return function(a, b, c, d, e, f, g, h) {-        return fn(a)(b)(c)(d)(e)(f)(g)(h);-      };-    }-    """ :: forall a b c d e f g h i. (a -> b -> c -> d -> e -> f -> g -> h -> i) -> Fn8 a b c d e f g h i--  -- | Create a function of nine arguments from a curried function-  foreign import mkFn9-    """-    function mkFn9(fn) {-      return function(a, b, c, d, e, f, g, h, i) {-        return fn(a)(b)(c)(d)(e)(f)(g)(h)(i);-      };-    }-    """ :: forall a b c d e f g h i j. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> Fn9 a b c d e f g h i j--  -- | Create a function of ten arguments from a curried function-  foreign import mkFn10-    """-    function mkFn10(fn) {-      return function(a, b, c, d, e, f, g, h, i, j) {-        return fn(a)(b)(c)(d)(e)(f)(g)(h)(i)(j);-      };-    }-    """ :: forall a b c d e f g h i j k. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> Fn10 a b c d e f g h i j k--  -- | Apply a function of no arguments-  foreign import runFn0-    """-    function runFn0(fn) {-      return fn();-    }-    """ :: forall a. Fn0 a -> a--  -- | Apply a function of one argument-  foreign import runFn1-    """-    function runFn1(fn) {-      return function(a) {-        return fn(a);-      };-    }-    """ :: forall a b. Fn1 a b -> a -> b--  -- | Apply a function of two arguments-  foreign import runFn2-    """-    function runFn2(fn) {-      return function(a) {-        return function(b) {-          return fn(a, b);-        };-      };-    }-    """ :: forall a b c. Fn2 a b c -> a -> b -> c--  -- | Apply a function of three arguments-  foreign import runFn3-    """-    function runFn3(fn) {-      return function(a) {-        return function(b) {-          return function(c) {-            return fn(a, b, c);-          };-        };-      };-    }-    """ :: forall a b c d. Fn3 a b c d -> a -> b -> c -> d--  -- | Apply a function of four arguments-  foreign import runFn4-    """-    function runFn4(fn) {-      return function(a) {-        return function(b) {-          return function(c) {-            return function(d) {-              return fn(a, b, c, d);-            };-          };-        };-      };-    }-    """ :: forall a b c d e. Fn4 a b c d e -> a -> b -> c -> d -> e--  -- | Apply a function of five arguments-  foreign import runFn5-    """-    function runFn5(fn) {-      return function(a) {-        return function(b) {-          return function(c) {-            return function(d) {-              return function(e) {-                return fn(a, b, c, d, e);-              };-            };-          };-        };-      };-    }-    """ :: forall a b c d e f. Fn5 a b c d e f -> a -> b -> c -> d -> e -> f--  -- | Apply a function of six arguments-  foreign import runFn6-    """-    function runFn6(fn) {-      return function(a) {-        return function(b) {-          return function(c) {-            return function(d) {-              return function(e) {-                return function(f) {-                  return fn(a, b, c, d, e, f);-                };-              };-            };-          };-        };-      };-    }-    """ :: forall a b c d e f g. Fn6 a b c d e f g -> a -> b -> c -> d -> e -> f -> g--  -- | Apply a function of seven arguments-  foreign import runFn7-    """-    function runFn7(fn) {-      return function(a) {-        return function(b) {-          return function(c) {-            return function(d) {-              return function(e) {-                return function(f) {-                  return function(g) {-                    return fn(a, b, c, d, e, f, g);-                  };-                };-              };-            };-          };-        };-      };-    }-    """ :: forall a b c d e f g h. Fn7 a b c d e f g h -> a -> b -> c -> d -> e -> f -> g -> h--  -- | Apply a function of eight arguments-  foreign import runFn8-    """-    function runFn8(fn) {-      return function(a) {-        return function(b) {-          return function(c) {-            return function(d) {-              return function(e) {-                return function(f) {-                  return function(g) {-                    return function(h) {-                      return fn(a, b, c, d, e, f, g, h);-                    };-                  };-                };-              };-            };-          };-        };-      };-    }-    """ :: forall a b c d e f g h i. Fn8 a b c d e f g h i -> a -> b -> c -> d -> e -> f -> g -> h -> i--  -- | Apply a function of nine arguments-  foreign import runFn9-    """-    function runFn9(fn) {-      return function(a) {-        return function(b) {-          return function(c) {-            return function(d) {-              return function(e) {-                return function(f) {-                  return function(g) {-                    return function(h) {-                      return function(i) {-                        return fn(a, b, c, d, e, f, g, h, i);-                      };-                    };-                  };-                };-              };-            };-          };-        };-      };-    }-    """ :: forall a b c d e f g h i j. Fn9 a b c d e f g h i j -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j--  -- | Apply a function of ten arguments-  foreign import runFn10-    """-    function runFn10(fn) {-      return function(a) {-        return function(b) {-          return function(c) {-            return function(d) {-              return function(e) {-                return function(f) {-                  return function(g) {-                    return function(h) {-                      return function(i) {-                        return function(j) {-                          return fn(a, b, c, d, e, f, g, h, i, j);-                        };-                      };-                    };-                  };-                };-              };-            };-          };-        };-      };-    }-    """ :: forall a b c d e f g h i j k. Fn10 a b c d e f g h i j k -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k--module Prelude.Unsafe where--  -- | Find the element of an array at the specified index.-  -- |-  -- | Note: this function can cause unpredictable failure at runtime if the index is out-of-bounds.-  foreign import unsafeIndex-    """-    function unsafeIndex(xs) {-      return function(n) {-        return xs[n];-      };-    }-    """ :: forall a. [a] -> Number -> a--module Control.Monad.Eff-  ( Eff()-  , Pure()-  , runPure-  , untilE, whileE, forE, foreachE-  ) where--  -- | The `Eff` type constructor is used to represent _native_ effects.-  -- |-  -- | See [Handling Native Effects with the Eff Monad](https://github.com/purescript/purescript/wiki/Handling-Native-Effects-with-the-Eff-Monad) for more details.-  -- |-  -- | The first type parameter is a row of effects which represents the contexts in which a computation can be run, and the second type parameter is the return type.-  foreign import data Eff :: # ! -> * -> *--  foreign import returnE-    """-    function returnE(a) {-      return function() {-        return a;-      };-    }-    """ :: forall e a. a -> Eff e a--  foreign import bindE-    """-    function bindE(a) {-      return function(f) {-        return function() {-          return f(a())();-        };-      };-    }-    """ :: forall e a b. Eff e a -> (a -> Eff e b) -> Eff e b--  -- | The `Pure` type synonym represents _pure_ computations, i.e. ones in which all effects have been handled.-  -- |-  -- | The `runPure` function can be used to run pure computations and obtain their result.-  type Pure a = forall e. Eff e a--  -- | Run a pure computation and return its result.-  -- |-  -- | Note: since this function has a rank-2 type, it may cause problems to apply this function using the `$` operator. The recommended approach-  -- | is to use parentheses instead.-  foreign import runPure-    """-    function runPure(f) {-      return f();-    }-    """ :: forall a. Pure a -> a--  instance functorEff :: Functor (Eff e) where-    (<$>) = liftA1--  instance applyEff :: Apply (Eff e) where-    (<*>) = ap--  instance applicativeEff :: Applicative (Eff e) where-    pure = returnE--  instance bindEff :: Bind (Eff e) where-    (>>=) = bindE--  instance monadEff :: Monad (Eff e)--  -- | Loop until a condition becomes `true`.-  -- |-  -- | `untilE b` is an effectful computation which repeatedly runs the effectful computation `b`,-  -- | until its return value is `true`.-  foreign import untilE-    """-    function untilE(f) {-      return function() {-        while (!f());-        return {};-      };-    }-    """ :: forall e. Eff e Boolean -> Eff e Unit--  -- | Loop while a condition is `true`.-  -- |-  -- | `whileE b m` is effectful computation which runs the effectful computation `b`. If its result is-  -- | `true`, it runs the effectful computation `m` and loops. If not, the computation ends.-  foreign import whileE-    """-    function whileE(f) {-      return function(a) {-        return function() {-          while (f()) {-            a();-          }-          return {};-        };-      };-    }-    """ :: forall e a. Eff e Boolean -> Eff e a -> Eff e Unit--  -- | Loop over a consecutive collection of numbers.-  -- |-  -- | `forE lo hi f` runs the computation returned by the function `f` for each of the inputs-  -- | between `lo` (inclusive) and `hi` (exclusive).-  foreign import forE-    """-    function forE(lo) {-      return function(hi) {-        return function(f) {-          return function() {-            for (var i = lo; i < hi; i++) {-              f(i)();-            }-          };-        };-      };-    }-    """ :: forall e. Number -> Number -> (Number -> Eff e Unit) -> Eff e Unit--  -- | Loop over an array of values.-  -- |-  -- | `foreach xs f` runs the computation returned by the function `f` for each of the inputs `xs`.-  foreign import foreachE-    """-    function foreachE(as) {-      return function(f) {-        return function() {-          for (var i = 0; i < as.length; i++) {-            f(as[i])();-          }-        };-      };-    }-    """ :: forall e a. [a] -> (a -> Eff e Unit) -> Eff e Unit--module Control.Monad.Eff.Unsafe where--  import Control.Monad.Eff--  -- | Change the type of an effectful computation, allowing it to be run in another context.-  -- |-  -- | Note: use of this function can result in arbitrary side-effects.-  foreign import unsafeInterleaveEff-    """-    function unsafeInterleaveEff(f) {-      return f;-    }-    """ :: forall eff1 eff2 a. Eff eff1 a -> Eff eff2 a--module Debug.Trace where--  import Control.Monad.Eff--  -- | The `Trace` effect represents those computations which write to the console.-  foreign import data Trace :: !--  -- | Write a `String` to the console.-  foreign import trace-    """-    function trace(s) {-      return function() {-        console.log(s);-        return {};-      };-    }-    """ :: forall r. String -> Eff (trace :: Trace | r) Unit--  -- | Write a value to the console, using its `Show` instance to produce a `String`.-  print :: forall a r. (Show a) => a -> Eff (trace :: Trace | r) Unit-  print o = trace (show o)--module Control.Monad.ST where--  import Control.Monad.Eff--  -- | The `ST` effect represents _local mutation_, i.e. mutation which does not "escape" into the surrounding computation.-  -- |-  -- | An `ST` computation is parameterized by a phantom type which is used to restrict the set of reference cells it is allowed to access.-  -- |-  -- | The `runST` function can be used to handle the `ST` effect.-  foreign import data ST :: * -> !--  -- | The type `STRef s a` represents a mutable reference holding a value of type `a`, which can be used with the `ST s` effect.-  foreign import data STRef :: * -> * -> *--  -- | Create a new mutable reference.-  foreign import newSTRef-    """-    function newSTRef(val) {-      return function() {-        return { value: val };-      };-    }-    """ :: forall a h r. a -> Eff (st :: ST h | r) (STRef h a)--  -- | Read the current value of a mutable reference.-  foreign import readSTRef-    """-    function readSTRef(ref) {-      return function() {-        return ref.value;-      };-    }-    """ :: forall a h r. STRef h a -> Eff (st :: ST h | r) a--  -- | Modify the value of a mutable reference by applying a function to the current value.-  foreign import modifySTRef-    """-    function modifySTRef(ref) {-      return function(f) {-        return function() {-          return ref.value = f(ref.value);-        };-      };-    }-    """ :: forall a h r. STRef h a -> (a -> a) -> Eff (st :: ST h | r) a--  -- | Set the value of a mutable reference.-  foreign import writeSTRef-    """-    function writeSTRef(ref) {-      return function(a) {-        return function() {-          return ref.value = a;-        };-      };-    }-    """ :: forall a h r. STRef h a -> a -> Eff (st :: ST h | r) a--  -- | Run an `ST` computation.-  -- |-  -- | Note: the type of `runST` uses a rank-2 type to constrain the phantom type `s`, such that the computation must not leak any mutable references-  -- | to the surrounding computation.-  -- |-  -- | It may cause problems to apply this function using the `$` operator. The recommended approach is to use parentheses instead.-  foreign import runST-    """-    function runST(f) {-      return f;-    }-    """ :: forall a r. (forall h. Eff (st :: ST h | r) a) -> Eff r a--  -- | A convenience function which combines `runST` with `runPure`, which can be used when the only required effect is `ST`.-  -- |-  -- | Note: since this function has a rank-2 type, it may cause problems to apply this function using the `$` operator. The recommended approach-  -- | is to use parentheses instead.-  pureST :: forall a. (forall h r. Eff (st :: ST h | r) a) -> a-  pureST st = runPure (runST st)

+ psc-bundle/Main.hs view

@@ -0,0 +1,621 @@+-----------------------------------------------------------------------------+--+-- Module      :  psc-bundle+-- Copyright   :  (c) Phil Freeman 2015+-- License     :  MIT+--+-- Maintainer  :  Phil Freeman <paf31@cantab.net>+-- Stability   :  experimental+-- Portability :+--+-- | Bundles compiled PureScript modules for the browser.+--+-----------------------------------------------------------------------------++{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE RecordWildCards #-}++module Main (main) where++import Data.List (nub)+import Data.Maybe (mapMaybe, catMaybes)+import Data.Traversable (for)+import Data.Generics (everything, everywhere, mkQ, mkT)+import Data.Graph+import Data.Version (showVersion)++import qualified Data.Set as S++import Control.Applicative+import Control.Monad+import Control.Monad.Error.Class+import Control.Monad.Trans.Except+import Control.Monad.IO.Class++import System.FilePath (takeFileName, takeDirectory)+import System.FilePath.Glob (glob)+import System.Exit (exitFailure)+import System.IO (stderr, hPutStrLn)+import System.Directory (createDirectoryIfMissing)++import Language.JavaScript.Parser++import Options.Applicative as Opts++import qualified Paths_purescript as Paths++-- | The type of error messages. We separate generation and rendering of errors using a data+-- type, in case we need to match on error types later.+data ErrorMessage+  = UnsupportedModulePath String+  | InvalidTopLevel+  | UnableToParseModule+  | UnsupportedExport+  | ErrorInFile FilePath ErrorMessage+  deriving Show++-- | Modules are either "regular modules" (i.e. those generated by psc-make) or foreign modules.+data ModuleType +  = Regular +  | Foreign +  deriving (Show, Eq, Ord)+  +-- | A module is identified by its module name and its type.+data ModuleIdentifier = ModuleIdentifier String ModuleType deriving (Show, Eq, Ord)++moduleName :: ModuleIdentifier -> String+moduleName (ModuleIdentifier name _) = name++-- | A piece of code is identified by its module and its name. These keys are used to label vertices+-- in the dependency graph.+type Key = (ModuleIdentifier, String)++-- | An export is either a "regular export", which exports a name from the regular module we are in,+-- or a reexport of a declaration in the corresponding foreign module.+-- +-- Regular exports are labelled, since they might re-export an operator with another name. +data ExportType +  = RegularExport String +  | ForeignReexport +  deriving (Show, Eq, Ord)++-- | There are four types of module element we are interested in:+--+-- 1) Require statements+-- 2) Member declarations+-- 3) Export lists+-- 4) Everything else+--+-- Each is labelled with the original AST node which generated it, so that we can dump it back+-- into the output during codegen.+data ModuleElement +  = Require JSNode String ModuleIdentifier+  | Member JSNode Bool String [JSNode] [Key]+  | ExportsList [(ExportType, String, JSNode, [Key])]+  | Other JSNode+  deriving Show++-- | A module is just a list of elements of the types listed above. +data Module = Module ModuleIdentifier [ModuleElement] deriving Show+  +-- | Command line options.+data Options = Options+  { optionsInputFiles  :: [FilePath]+  , optionsOutputFile  :: Maybe FilePath+  , optionsEntryPoints :: [String]+  , optionsMainModule  :: Maybe String+  , optionsNamespace   :: String+  } deriving Show++-- | Prepare an error message for consumption by humans.+printErrorMessage :: ErrorMessage -> [String]+printErrorMessage (UnsupportedModulePath s) =+  [ "A CommonJS module has an unsupported name (" ++ show s ++ ")."+  , "The following file names are supported:"+  , "  1) index.js (psc-make native modules)"+  , "  2) foreign.js (psc-make foreign modules)"+  ]+printErrorMessage InvalidTopLevel =+  [ "Expected a list of source elements at the top level." ] +printErrorMessage UnableToParseModule =+  [ "The module could not be parsed." ]+printErrorMessage UnsupportedExport =+  [ "An export was unsupported. Exports can be defined in one of two ways: "+  , "  1) exports.name = ..."+  , "  2) exports = { ... }"+  ]+printErrorMessage (ErrorInFile filename e) =+  ("Error in file " ++ show filename ++ ":")+  : ""+  : map ("  " ++) (printErrorMessage e)++-- | Unpack the node inside a JSNode. This is useful when pattern matching.+node :: JSNode -> Node+node (NN n) = n+node (NT n _ _) = n++-- | Given a filename, assuming it is in the correct place on disk, infer a ModuleIdentifier.+guessModuleIdentifier :: (Applicative m, MonadError ErrorMessage m) => FilePath -> m ModuleIdentifier+guessModuleIdentifier filename = ModuleIdentifier (takeFileName (takeDirectory filename)) <$> (guessModuleType (takeFileName filename))+  where+  guessModuleType "index.js" = pure Regular+  guessModuleType "foreign.js" = pure Foreign +  guessModuleType name = throwError $ UnsupportedModulePath name++-- | Calculate the ModuleIdentifier which a require(...) statement imports.+checkImportPath :: String -> ModuleIdentifier -> S.Set String -> Maybe ModuleIdentifier+checkImportPath "./foreign" m _     = +  Just (ModuleIdentifier (moduleName m) Foreign)+checkImportPath name        _ names +  | name `S.member` names = Just (ModuleIdentifier name Regular)+checkImportPath _           _ _     = Nothing++-- | Compute the dependencies of all elements in a module, and add them to the tree.+-- +-- Members and exports can have dependencies. A dependency is of one of the following forms:+--+-- 1) module.name or member["name"]+--    +--    where module was imported using+--+--    var module = require("Module.Name");+--+-- 2) name+--+--    where name is the name of a member defined in the current module.+withDeps :: Module -> Module+withDeps (Module modulePath es) = Module modulePath (map expandDeps es)+  where    +  -- | Collects all modules which are imported, so that we can identify dependencies of the first type.+  imports :: [(String, ModuleIdentifier)]+  imports = mapMaybe toImport es+    where+    toImport :: ModuleElement -> Maybe (String, ModuleIdentifier)+    toImport (Require _ nm mid) = Just (nm, mid)+    toImport _ = Nothing+    +  -- | Collects all member names in scope, so that we can identify dependencies of the second type.+  boundNames :: [String]+  boundNames = mapMaybe toBoundName es+    where+    toBoundName :: ModuleElement -> Maybe String+    toBoundName (Member _ _ nm _ _) = Just nm+    toBoundName _ = Nothing++  -- | Calculate dependencies and add them to the current element.+  expandDeps :: ModuleElement -> ModuleElement+  expandDeps (Member n f nm decl _) = Member n f nm decl (nub (concatMap (dependencies modulePath) decl))+  expandDeps (ExportsList exps) = ExportsList (map expand exps)+      where+      expand (ty, nm, n1, _) = (ty, nm, n1, nub (dependencies modulePath n1))+  expandDeps other = other+  +  dependencies :: ModuleIdentifier -> JSNode -> [(ModuleIdentifier, String)]+  dependencies m = everything (++) (mkQ [] toReference)+    where+    toReference :: Node -> [(ModuleIdentifier, String)]+    toReference (JSMemberDot [ mn ] _ nm)+      | JSIdentifier mn' <- node mn+      , JSIdentifier nm' <- node nm+      , Just mid <- lookup mn' imports+      = [(mid, nm')]+    toReference (JSMemberSquare [ mn ] _ nm _)+      | JSIdentifier mn' <- node mn+      , JSExpression [ s ] <- node nm+      , JSStringLiteral _ nm' <- node s+      , Just mid <- lookup mn' imports+      = [(mid, nm')]+    toReference (JSIdentifier nm)+      | nm `elem` boundNames+      = [(m, nm)]+    toReference _ = []++-- | Attempt to create a Module from a Javascript AST.+-- +-- Each type of module element is matched using pattern guards, and everything else is bundled into the +-- Other constructor.+toModule :: forall m. (Applicative m, MonadError ErrorMessage m) => S.Set String -> ModuleIdentifier -> JSNode -> m Module+toModule mids mid top +  | JSSourceElementsTop ns <- node top = Module mid <$> mapM toModuleElement ns+  | otherwise = throwError InvalidTopLevel+  where      +  toModuleElement :: JSNode -> m ModuleElement+  toModuleElement n+    | JSVariables var [ varIntro ] _ <- node n+    , JSLiteral "var" <- node var +    , JSVarDecl impN [ eq, req, impP ] <- node varIntro+    , JSIdentifier importName <- node impN+    , JSLiteral "=" <- node eq+    , JSIdentifier "require" <- node req+    , JSArguments _ [ impS ] _ <- node impP +    , JSStringLiteral _ importPath <- node impS+    , Just importPath' <- checkImportPath importPath mid mids+    = pure (Require n importName importPath')+  toModuleElement n+    | JSVariables var [ varIntro ] _ <- node n+    , JSLiteral "var" <- node var +    , JSVarDecl declN (eq : decl) <- node varIntro+    , JSIdentifier name <- node declN+    , JSLiteral "=" <- node eq+    = pure (Member n False name decl [])+  toModuleElement n+    | JSExpression (e : op : decl) <- node n+    , Just name <- accessor (node e)+    , JSOperator eq <- node op+    , JSLiteral "=" <- node eq+    = pure (Member n True name decl [])+    where+    accessor :: Node -> Maybe String+    accessor (JSMemberDot [ exports ] _ nm)+      | JSIdentifier "exports" <- node exports+      , JSIdentifier name <- node nm+      = Just name+    accessor (JSMemberSquare [ exports ] _ nm _)+      | JSIdentifier "exports" <- node exports+      , JSExpression [e] <- node nm+      , JSStringLiteral _ name <- node e+      = Just name+    accessor _ = Nothing+  toModuleElement n+    | JSExpression (mnExp : op : obj: _) <- node n+    , JSMemberDot [ mn ] _ e <- node mnExp+    , JSIdentifier "module" <- node mn+    , JSIdentifier "exports" <- node e+    , JSOperator eq <- node op+    , JSLiteral "=" <- node eq+    , JSObjectLiteral _ props _ <- node obj+    = ExportsList <$> mapM toExport (filter (not . isSeparator) (map node props))+    where+    toExport :: Node -> m (ExportType, String, JSNode, [Key])+    toExport (JSPropertyNameandValue name _ [val] ) = +      (,,val,[]) <$> exportType (node val) +                 <*> extractLabel (node name)+    toExport _ = throwError UnsupportedExport+  +    exportType :: Node -> m ExportType+    exportType (JSMemberDot [f] _ _)+      | JSIdentifier "$foreign" <- node f+      = pure ForeignReexport+    exportType (JSMemberSquare [f] _ _ _)+      | JSIdentifier "$foreign" <- node f+      = pure ForeignReexport+    exportType (JSIdentifier s) = pure (RegularExport s)+    exportType _ = throwError UnsupportedExport+  +    extractLabel :: Node -> m String+    extractLabel (JSStringLiteral _ nm) = pure nm+    extractLabel (JSIdentifier nm) = pure nm+    extractLabel _ = throwError UnsupportedExport+    +    isSeparator :: Node -> Bool+    isSeparator (JSLiteral ",") = True+    isSeparator _ = False+  toModuleElement other = pure (Other other)++-- | Eliminate unused code based on the specified entry point set.+compile :: [Module] -> [ModuleIdentifier] -> [Module]+compile modules [] = modules+compile modules entryPoints = filteredModules+  where    +  (graph, _, vertexFor) = graphFromEdges verts+  +  -- | The vertex set+  verts :: [(ModuleElement, Key, [Key])]+  verts = do+    Module mid els <- modules+    concatMap (toVertices mid) els+    where+    -- | Create a set of vertices for a module element.+    -- +    -- Some special cases worth commenting on:+    --+    -- 1) Regular exports which simply export their own name do not count as dependencies.+    --    Regular exports which rename and reexport an operator do count, however.+    -- +    -- 2) Require statements don't contribute towards dependencies, since they effectively get+    --    inlined wherever they are used inside other module elements.+    toVertices :: ModuleIdentifier -> ModuleElement -> [(ModuleElement, Key, [Key])]+    toVertices p m@(Member _ _ nm _ deps) = [(m, (p, nm), deps)]+    toVertices p m@(ExportsList exps) = mapMaybe toVertex exps+      where+      toVertex (ForeignReexport, nm, _, ks) = Just (m, (p, nm), ks)+      toVertex (RegularExport nm, nm1, _, ks) | nm /= nm1 = Just (m, (p, nm1), ks)+      toVertex _ = Nothing+    toVertices _ _ = []+  +  -- | The set of vertices whose connected components we are interested in keeping.+  entryPointVertices :: [Vertex]+  entryPointVertices = catMaybes $ do+    (_, k@(mid, _), _) <- verts+    guard $ mid `elem` entryPoints+    return (vertexFor k)+  +  -- | The set of vertices reachable from an entry point+  reachableSet :: S.Set Vertex+  reachableSet = S.fromList (concatMap (reachable graph) entryPointVertices)+  +  filteredModules :: [Module]+  filteredModules = map filterUsed modules+    where+    filterUsed :: Module -> Module+    filterUsed (Module mid ds) = Module mid (map filterExports (go ds))+      where+      go :: [ModuleElement] -> [ModuleElement]+      go [] = []+      go (d : Other semi : rest) +        | JSLiteral ";" <- node semi+        , not (isDeclUsed d)+        = go rest+      go (d : rest) +        | not (isDeclUsed d) = go rest+        | otherwise = d : go rest+        +      -- | Filter out the exports for members which aren't used.+      filterExports :: ModuleElement -> ModuleElement+      filterExports (ExportsList exps) = ExportsList (filter (\(_, nm, _, _) -> isKeyUsed (mid, nm)) exps)+      filterExports me = me+    +      isDeclUsed :: ModuleElement -> Bool+      isDeclUsed (Member _ _ nm _ _) = isKeyUsed (mid, nm)+      isDeclUsed _ = True+      +      isKeyUsed :: Key -> Bool+      isKeyUsed k +        | Just me <- vertexFor k = me `S.member` reachableSet+        | otherwise = False+  +-- | Topologically sort the module dependency graph, so that when we generate code, modules can be +-- defined in the right order.+sortModules :: [Module] -> [Module]+sortModules modules = map (\v -> case nodeFor v of (n, _, _) -> n) (reverse (topSort graph))+  where+  (graph, nodeFor, _) = graphFromEdges $ do+    m@(Module mid els) <- modules+    return (m, mid, mapMaybe getKey els)+    +  getKey :: ModuleElement -> Maybe ModuleIdentifier+  getKey (Require _ _ mi) = Just mi +  getKey _ = Nothing+  +-- | A module is empty if it contains no exported members (in other words,+-- if the only things left after dead code elimination are module imports and+-- "other" foreign code).+--+-- If a module is empty, we don't want to generate code for it.+isModuleEmpty :: Module -> Bool+isModuleEmpty (Module _ els) = all isElementEmpty els+  where+  isElementEmpty :: ModuleElement -> Bool+  isElementEmpty (ExportsList exps) = null exps+  isElementEmpty (Require _ _ _) = True+  isElementEmpty (Other _) = True+  isElementEmpty _ = False+  +-- | Generate code for a set of modules, including a call to main().+--+-- Modules get defined on the global PS object, as follows:+--+--     var PS = { };+--     (function(exports) {+--       ...+--     })(PS["Module.Name"] = PS["Module.Name"] || {});+--+-- 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-make).+codeGen :: Options -> [Module] -> String+codeGen Options{..} ms = renderToString (NN (JSSourceElementsTop (prelude ++ concatMap moduleToJS ms ++ maybe [] runMain optionsMainModule)))+  where+  moduleToJS :: Module -> [JSNode]+  moduleToJS (Module mn ds) = wrap (moduleName mn) (indent (concatMap declToJS ds))+    where+    declToJS :: ModuleElement -> [JSNode]+    declToJS (Member n _ _ _ _) = [n]+    declToJS (Other n) = [n]       +    declToJS (Require _ nm req) = +      [ NN (JSVariables (NT (JSLiteral "var") tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n  " ]) +                        [ NN (JSVarDecl (sp (JSIdentifier nm)) +                                        [ sp (JSLiteral "=")+                                        , moduleReference sp (moduleName req)+                                        ])+                        ]+                        (nt (JSLiteral ";"))) ]+    declToJS (ExportsList exps) = map toExport exps+      +      where +      toExport :: (ExportType, String, JSNode, [Key]) -> JSNode+      toExport (_, nm, val, _) =+        NN (JSExpression [ NN (JSMemberSquare [ NT (JSIdentifier "exports") tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n  " ] ] +                                              (nt (JSLiteral "[")) +                                              (NN (JSExpression [ nt (JSStringLiteral '"' nm) ]))+                                              (nt (JSLiteral "]")))+                         , NN (JSOperator (sp (JSLiteral "=")))+                         , reindent val+                         , nt (JSLiteral ";")+                         ])+      +      reindent :: JSNode -> JSNode+      reindent (NT n _ _) = sp n+      reindent nn = nn+  +  indent :: [JSNode] -> [JSNode]+  indent = everywhere (mkT squash)+    where+    squash (NT n pos ann) = NT n (keepCol pos) (map splat ann)+    squash nn = nn+    +    splat (CommentA pos s) = CommentA (keepCol pos) s+    splat (WhiteSpace pos w) = WhiteSpace (keepCol pos) w+    splat ann = ann+    +    keepCol (TokenPn _ _ c) = TokenPn 0 0 (c + 2)+    +  prelude :: [JSNode]+  prelude = +    [ NN (JSVariables (NT (JSLiteral "var") tokenPosnEmpty [ CommentA tokenPosnEmpty ("// Generated by psc-bundle " ++ showVersion Paths.version)+                                                           , WhiteSpace tokenPosnEmpty "\n"+                                                           ]) +                                                           [ NN (JSVarDecl (sp (JSIdentifier optionsNamespace)) +                                                                           [ sp (JSLiteral "=")+                                                                           , NN (JSObjectLiteral (sp (JSLiteral "{")) +                                                                                                 []+                                                                                                 (sp (JSLiteral "}")))+                                                                           ])+                                                           ] +                                                           (nt (JSLiteral ";")))+    , lf+    ]+    +  moduleReference :: (Node -> JSNode) -> String -> JSNode+  moduleReference f mn = +    NN (JSMemberSquare [ f (JSIdentifier optionsNamespace) ] +                       (nt (JSLiteral "[")) +                       (NN (JSExpression [ nt (JSStringLiteral '"' mn) ]))+                       (nt (JSLiteral "]")))+    +  wrap :: String -> [JSNode] -> [JSNode]+  wrap mn ds = +    [ NN (JSExpression [ NN (JSExpressionParen (nt (JSLiteral "(")) +                                               (NN (JSExpression [ NN (JSFunctionExpression (nt (JSLiteral "function")) +                                                                                            [] +                                                                                            (nt (JSLiteral "(") ) [nt (JSIdentifier "exports")] (nt (JSLiteral ")")) +                                                                                            (NN (JSBlock [sp (JSLiteral "{")] +                                                                                                         (lf : ds)+                                                                                                         [nl (JSLiteral "}")])))]))+                                               (nt (JSLiteral ")")))+                       , NN (JSArguments (nt (JSLiteral "(")) +                                         [ NN (JSExpression [ moduleReference nt mn+                                                            , NN (JSOperator (sp (JSLiteral "=")))+                                                            , NN (JSExpressionBinary "||"+                                                                                     [ moduleReference sp mn ] +                                                                                     (sp (JSLiteral "||")) +                                                                                     [ emptyObj ]) +                                                            ])+                                         ]+                                         (nt (JSLiteral ")")))+                       ])+    , nt (JSLiteral ";")+    , lf+    ]+    where+    emptyObj = NN (JSObjectLiteral (sp (JSLiteral "{")) [] (nt (JSLiteral "}")))+    +  runMain :: String -> [JSNode]+  runMain mn = +    [ NN (JSExpression [ NN (JSMemberDot [ NN (JSMemberSquare [ nl (JSIdentifier optionsNamespace) ] +                                                              (nt (JSLiteral "[")) +                                                              (NN (JSExpression [ nt (JSStringLiteral '"' mn) ])) +                                                              (nt (JSLiteral "]")))+                                         ] +                                         (nt (JSLiteral ".")) +                                         (nt (JSIdentifier "main")))+                       , NN (JSArguments (nt (JSLiteral "(")) [] (nt (JSLiteral ")")))+                       ])+    , nt (JSLiteral ";")+    ]+  +  nt :: Node -> JSNode+  nt n = NT n tokenPosnEmpty []+  +  lf :: JSNode+  lf = NT (JSLiteral "") tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n" ]+  +  sp :: Node -> JSNode+  sp n = NT n tokenPosnEmpty [ WhiteSpace tokenPosnEmpty " " ]+  +  nl :: Node -> JSNode+  nl n = NT n tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n" ]++-- | The main application function.+-- This function parses the input files, performs dead code elimination, filters empty modules+-- and generates and prints the final Javascript bundle.+app :: forall m. (Applicative m, MonadError ErrorMessage m, MonadIO m) => Options -> m String+app opts@Options{..} = do+  inputFiles <- concat <$> mapM (liftIO . glob) optionsInputFiles+  when (null inputFiles) . liftIO $ do+    hPutStrLn stderr "psc-bundle: No input files."+    exitFailure+  input <- for inputFiles $ \filename -> do+    js <- liftIO (readFile filename)+    ast <- fromRight (parse js filename)+    mid <- guessModuleIdentifier filename+    return (mid, ast)+    +  let mids = S.fromList (map (moduleName . fst) input)+    +  modules <- mapM (fmap withDeps . uncurry (toModule mids)) input+  +  let compiled = compile modules (map (`ModuleIdentifier` Regular) optionsEntryPoints)+      sorted   = sortModules (filter (not . isModuleEmpty) compiled)+  +  return (codeGen opts sorted)+  +  where+  fromRight :: Either a b -> m b+  fromRight (Right b) = pure b+  fromRight (Left _) = throwError UnableToParseModule+    +-- | Command line options parser.+options :: Parser Options+options = Options <$> some inputFile+                  <*> optional outputFile+                  <*> many entryPoint+                  <*> optional mainModule+                  <*> namespace+  where                  +  inputFile :: Parser FilePath+  inputFile = strArgument $+       metavar "FILE"+    <> help "The input .js file(s)"+    +  outputFile :: Parser FilePath	+  outputFile = strOption $		+       short 'o'		+    <> long "output"		+    <> help "The output .js file"+    +  entryPoint :: Parser String+  entryPoint = strOption $+       short 'm'+    <> long "module"+    <> help "Entry point module name(s). All code which is not a transitive dependency of an entry point module will be removed."+      +  mainModule :: Parser String+  mainModule = strOption $+       long "main"+    <> help "Generate code to run the main method in the specified module."+    +  namespace :: Parser String+  namespace = strOption $+       short 'n'+    <> long "namespace"+    <> Opts.value "PS"+    <> showDefault+    <> help "Specify the namespace that PureScript modules will be exported to when running in the browser."+    +-- | Make it go. +main :: IO ()+main = do+  opts <- execParser (info (version <*> helper <*> options) infoModList)+  output <- runExceptT (app opts)+  case output of+    Left err -> do+      hPutStrLn stderr (unlines (printErrorMessage err))+      exitFailure+    Right js ->+      case optionsOutputFile opts of+        Just outputFile -> do+          createDirectoryIfMissing True (takeDirectory outputFile)+          writeFile outputFile js+        Nothing -> putStrLn js+  where+  infoModList = fullDesc <> headerInfo <> footerInfo+  headerInfo  = header   "psc-bundle - Bundles compiled PureScript modules for the browser"+  footerInfo  = footer $ "psc-bundle " ++ showVersion Paths.version++  version :: Parser (a -> a)+  version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden

psc-docs/Main.hs view

@@ -1,3 +1,4 @@+{-# LANGUAGE TupleSections #-} ---------------------------------------------------------------------------- -- -- Module      :  Main@@ -15,223 +16,135 @@ module Main where  import Control.Applicative-import Control.Monad+import Control.Arrow (first, second)+import Control.Category ((>>>)) import Control.Monad.Writer-import Control.Arrow (first)+import Data.Function (on) import Data.List import Data.Maybe (fromMaybe)+import Data.Tuple (swap) import Data.Version (showVersion)-import Data.Foldable (traverse_)  import Options.Applicative+import qualified Text.PrettyPrint.ANSI.Leijen as PP  import qualified Language.PureScript as P import qualified Paths_purescript as Paths-import System.Exit (exitSuccess, exitFailure)+import System.Exit (exitFailure) import System.IO (hPutStrLn, stderr)+import System.Directory (createDirectoryIfMissing)+import System.FilePath (takeDirectory)+import System.FilePath.Glob (glob)  import Etags import Ctags+import qualified Language.PureScript.Docs as D+import qualified Language.PureScript.Docs.AsMarkdown as D  -- Available output formats data Format = Markdown -- Output documentation in Markdown format                | Ctags -- Output ctags symbol index suitable for use with vi                | Etags -- Output etags symbol index suitable for use with emacs+               deriving (Show, Eq, Ord) +-- | Available methods of outputting Markdown documentation+data DocgenOutput+  = EverythingToStdOut+  | ToStdOut [P.ModuleName]+  | ToFiles [(P.ModuleName, FilePath)]+  deriving (Show)+ data PSCDocsOptions = PSCDocsOptions   { pscdFormat :: Format   , pscdInputFiles  :: [FilePath]+  , pscdDocgen :: DocgenOutput   }+  deriving (Show)  docgen :: PSCDocsOptions -> IO ()-docgen (PSCDocsOptions fmt input) = do+docgen (PSCDocsOptions fmt inputGlob output) = do+  input <- concat <$> mapM glob inputGlob+  case fmt of+    Etags -> dumpTags input dumpEtags+    Ctags -> dumpTags input dumpCtags+    Markdown -> do+      e <- D.parseAndDesugar input [] (\_ ms -> return ms)+      case e of+        Left (D.ParseError err) -> do+          hPutStrLn stderr $ show err+          exitFailure+        Left (D.SortModulesError err) -> do+          hPutStrLn stderr $ P.prettyPrintMultipleErrors False err+          exitFailure+        Left (D.DesugarError err) -> do+          hPutStrLn stderr $ P.prettyPrintMultipleErrors False err+          exitFailure+        Right ms' ->+          case output of+            EverythingToStdOut ->+              putStrLn (D.renderModulesAsMarkdown ms')+            ToStdOut names -> do+              let (ms, missing) = takeModulesByName ms' names+              guardMissing missing+              putStrLn (D.renderModulesAsMarkdown ms)+            ToFiles names -> do+              let (ms, missing) = takeModulesByName' ms' names+              guardMissing missing+              let ms'' = groupBy ((==) `on` fst) . sortBy (compare `on` fst) $ map swap ms+              forM_ ms'' $ \grp -> do+                let fp = fst (head grp)+                createDirectoryIfMissing True (takeDirectory fp)+                writeFile fp (D.renderModulesAsMarkdown $ snd `map` grp)+  where+  guardMissing [] = return ()+  guardMissing [mn] = do+    hPutStrLn stderr ("psc-docs: error: unknown module \"" ++ show mn ++ "\"")+    exitFailure+  guardMissing mns = do+    hPutStrLn stderr "psc-docs: error: unknown modules:"+    forM_ mns $ \mn ->+      hPutStrLn stderr ("  * " ++ show mn)+    exitFailure++-- |+-- Given a list of module names and a list of modules, return a list of modules+-- whose names appeared in the given name list, together with a list of names+-- for which no module could be found in the module list.+--+takeModulesByName :: [P.Module] -> [P.ModuleName] -> ([P.Module], [P.ModuleName])+takeModulesByName modules names =+  first (map fst) (takeModulesByName' modules (map (,()) names))++-- |+-- Like takeModulesByName but also keeps some extra data with the module.+--+takeModulesByName' :: [P.Module] -> [(P.ModuleName, a)] -> ([(P.Module, a)], [P.ModuleName])+takeModulesByName' modules = foldl go ([], [])+  where+  go (ms, missing) (name, x) =+    case find ((== name) . P.getModuleName) modules of+      Just m  -> ((m, x) : ms, missing)+      Nothing -> (ms, name : missing)++dumpTags :: [FilePath] -> ([(String, P.Module)] -> [String]) -> IO ()+dumpTags input renderTags = do   e <- P.parseModulesFromFiles (fromMaybe "") <$> mapM (fmap (first Just) . parseFile) (nub input)   case e of     Left err -> do-      hPutStrLn stderr $ show err+      hPutStrLn stderr (show err)       exitFailure-    Right ms -> do-      case fmt of-       Markdown -> putStrLn . runDocs $ renderModules (map snd ms)-       Etags -> ldump $ dumpEtags $ pairs ms-       Ctags -> ldump $ dumpCtags $ pairs ms-      exitSuccess-  where pairs :: [(Maybe String, m)] -> [(String, m)]-        pairs = map (\(k,m) -> (fromMaybe "" k,m))-        ldump :: [String] -> IO ()-        ldump = mapM_ putStrLn-    -parseFile :: FilePath -> IO (FilePath, String)-parseFile input = (,) input <$> readFile input--type Docs = Writer [String] ()--runDocs :: Docs -> String-runDocs = unlines . execWriter--spacer :: Docs-spacer = tell [""]--headerLevel :: Int -> String -> Docs-headerLevel level hdr = tell [replicate level '#' ++ ' ' : hdr]--withIndent :: Int -> Docs -> Docs-withIndent indent = censor (map (replicate indent ' ' ++ ))--atIndent :: Int -> String -> Docs-atIndent indent text =-  let ls = lines text in-  withIndent indent (tell ls)--fenced :: String -> Docs-fenced text = fencedBlock (tell $ lines text)--fencedBlock :: Docs -> Docs-fencedBlock inner = do-  tell ["``` purescript"]-  inner-  tell ["```"]--ticks :: String -> String-ticks = ("`" ++) . (++ "`")--renderModules :: [P.Module] -> Docs-renderModules ms = do-  headerLevel 1 "Module Documentation"-  spacer-  mapM_ renderModule ms--renderModule :: P.Module -> Docs-renderModule mdl@(P.Module coms moduleName _ exps) = do-    headerLevel 2 $ "Module " ++ P.runModuleName moduleName-    spacer-    unless (null coms) $ do-      renderComments coms-      spacer-    renderTopLevel exps (P.exportedDeclarations mdl)-    spacer--renderTopLevel :: Maybe [P.DeclarationRef] -> [P.Declaration] -> Docs-renderTopLevel exps decls = forM_ decls $ \decl ->-  when (canRenderDecl decl) $ do-    traverse_ (headerLevel 4) (ticks `fmap` getDeclarationTitle decl)-    spacer-    renderDeclaration exps decl-    spacer--renderTypeclassImage :: P.ModuleName -> Docs-renderTypeclassImage name =-  let name' = P.runModuleName name-  in tell ["![" ++ name' ++ "](images/" ++ name' ++ ".png)"]--getDeclarationTitle :: P.Declaration -> Maybe String-getDeclarationTitle (P.TypeDeclaration name _)                      = Just (show name)-getDeclarationTitle (P.ExternDeclaration _ name _ _)                = Just (show name)-getDeclarationTitle (P.DataDeclaration _ name _ _)                  = Just (show name)-getDeclarationTitle (P.ExternDataDeclaration name _)                = Just (show name)-getDeclarationTitle (P.TypeSynonymDeclaration name _ _)             = Just (show name)-getDeclarationTitle (P.TypeClassDeclaration name _ _ _)   = Just (show name)-getDeclarationTitle (P.TypeInstanceDeclaration name _ _ _ _)        = Just (show name)-getDeclarationTitle (P.PositionedDeclaration _ _ d)                 = getDeclarationTitle d-getDeclarationTitle _                                               = Nothing+    Right ms ->+      ldump (renderTags (pairs ms)) -renderDeclaration :: Maybe [P.DeclarationRef] -> P.Declaration -> Docs-renderDeclaration _ (P.TypeDeclaration ident ty) =-  fenced $ show ident ++ " :: " ++ prettyPrintType' ty-renderDeclaration _ (P.ExternDeclaration _ ident _ ty) =-  fenced $ show ident ++ " :: " ++ prettyPrintType' ty-renderDeclaration exps (P.DataDeclaration dtype name args ctors) = do-  let-    typeApp  = foldl P.TypeApp (P.TypeConstructor (P.Qualified Nothing name)) (map toTypeVar args)-    typeName = prettyPrintType' typeApp-    exported = filter (P.isDctorExported name exps . fst) ctors-  fencedBlock $ do-    tell [show dtype ++ " " ++ typeName]-    zipWithM_ (\isFirst (ctor, tys) ->-                atIndent 2 $ (if isFirst then "= " else "| ") ++ P.runProperName ctor ++ " " ++ unwords (map P.prettyPrintTypeAtom tys))-              (True : repeat False) exported-renderDeclaration _ (P.ExternDataDeclaration name kind) =-  fenced $ "data " ++ P.runProperName name ++ " :: " ++ P.prettyPrintKind kind-renderDeclaration _ (P.TypeSynonymDeclaration name args ty) = do-  let-    typeApp  = foldl P.TypeApp (P.TypeConstructor (P.Qualified Nothing name)) (map toTypeVar args)-    typeName = prettyPrintType' typeApp-  fenced $ "type " ++ typeName ++ " = " ++ prettyPrintType' ty-renderDeclaration _ (P.TypeClassDeclaration name args implies ds) = do-  let impliesText = case implies of-                      [] -> ""-                      is -> "(" ++ intercalate ", " (map (\(pn, tys') -> show pn ++ " " ++ unwords (map P.prettyPrintTypeAtom tys')) is) ++ ") <= "-      classApp  = foldl P.TypeApp (P.TypeConstructor (P.Qualified Nothing name)) (map toTypeVar args)-      className = prettyPrintType' classApp-  fencedBlock $ do-    tell ["class " ++ impliesText ++ className ++ " where"]-    mapM_ renderClassMember ds   where-    renderClassMember (P.PositionedDeclaration _ _ d) = renderClassMember d-    renderClassMember (P.TypeDeclaration ident ty) = atIndent 2 $ show ident ++ " :: " ++ prettyPrintType' ty-    renderClassMember _ = error "Invalid argument to renderClassMember."-renderDeclaration _ (P.TypeInstanceDeclaration name constraints className tys _) = do-  let constraintsText = case constraints of-                          [] -> ""-                          cs -> "(" ++ intercalate ", " (map (\(pn, tys') -> show pn ++ " " ++ unwords (map P.prettyPrintTypeAtom tys')) cs) ++ ") => "-  fenced $ "instance " ++ show name ++ " :: " ++ constraintsText ++ show className ++ " " ++ unwords (map P.prettyPrintTypeAtom tys)-renderDeclaration exps (P.PositionedDeclaration _ com d) = do-  renderDeclaration exps d-  renderComments com-renderDeclaration _ _ = return ()--renderComments :: [P.Comment] -> Docs-renderComments cs = do-  let raw = concatMap toLines cs-  when (all hasPipe raw) $ do-    spacer-    atIndent 0 . unlines . map stripPipes $ raw-  where--  toLines (P.LineComment s) = [s]-  toLines (P.BlockComment s) = lines s--  hasPipe s = case dropWhile (== ' ') s of { ('|':_) -> True; _ -> False }--  stripPipes = dropPipe . dropWhile (== ' ')--  dropPipe ('|':' ':s) = s-  dropPipe ('|':s) = s-  dropPipe s = s--toTypeVar :: (String, Maybe P.Kind) -> P.Type-toTypeVar (s, Nothing) = P.TypeVar s-toTypeVar (s, Just k) = P.KindedType (P.TypeVar s) k--prettyPrintType' :: P.Type -> String-prettyPrintType' = P.prettyPrintType . P.everywhereOnTypes dePrim-  where-  dePrim ty@(P.TypeConstructor (P.Qualified _ name))-    | ty == P.tyBoolean || ty == P.tyNumber || ty == P.tyString =-      P.TypeConstructor $ P.Qualified Nothing name-  dePrim other = other+  pairs :: [(Maybe String, m)] -> [(String, m)]+  pairs = map (first (fromMaybe "")) -getName :: P.Declaration -> String-getName (P.TypeDeclaration ident _) = show ident-getName (P.ExternDeclaration _ ident _ _) = show ident-getName (P.DataDeclaration _ name _ _) = P.runProperName name-getName (P.ExternDataDeclaration name _) = P.runProperName name-getName (P.TypeSynonymDeclaration name _ _) = P.runProperName name-getName (P.TypeClassDeclaration name _ _ _) = P.runProperName name-getName (P.TypeInstanceDeclaration name _ _ _ _) = show name-getName (P.PositionedDeclaration _ _ d) = getName d-getName _ = error "Invalid argument to getName"+  ldump :: [String] -> IO ()+  ldump = mapM_ putStrLn -canRenderDecl :: P.Declaration -> Bool-canRenderDecl P.TypeDeclaration{} = True-canRenderDecl P.ExternDeclaration{} = True-canRenderDecl P.DataDeclaration{} = True-canRenderDecl P.ExternDataDeclaration{} = True-canRenderDecl P.TypeSynonymDeclaration{} = True-canRenderDecl P.TypeClassDeclaration{} = True-canRenderDecl P.TypeInstanceDeclaration{} = True-canRenderDecl (P.PositionedDeclaration _ _ d) = canRenderDecl d-canRenderDecl _ = False+parseFile :: FilePath -> IO (FilePath, String)+parseFile input = (,) input <$> readFile input  inputFile :: Parser FilePath inputFile = strArgument $@@ -242,24 +155,97 @@     readsPrec _ "etags" = [(Etags, "")]     readsPrec _ "ctags" = [(Ctags, "")]     readsPrec _ "markdown" = [(Markdown, "")]-    readsPrec _ _ = []    +    readsPrec _ _ = []  format :: Parser Format format = option auto $ value Markdown          <> long "format"          <> metavar "FORMAT"-         <> help "Set output FORMAT (markdown | etags | ctags)"  +         <> help "Set output FORMAT (markdown | etags | ctags)" -pscDocsOptions :: Parser PSCDocsOptions-pscDocsOptions = PSCDocsOptions <$> format <*> many inputFile+docgenModule :: Parser String+docgenModule = strOption $+                   long "docgen"+                <> help "A list of module names which should appear in the output. This can optionally include file paths to write individual modules to, by separating with a colon ':'. For example, Prelude:docs/Prelude.md. This option may be specified multiple times." +pscDocsOptions :: Parser (Format, [FilePath], [String])+pscDocsOptions = (,,) <$> format <*> many inputFile <*> many docgenModule++parseDocgen :: [String] -> Either String DocgenOutput+parseDocgen [] = Right EverythingToStdOut+parseDocgen xs = go xs+  where+  go = intersperse " "+    >>> concat+    >>> words+    >>> map parseItem+    >>> combine++data DocgenOutputItem+  = IToStdOut P.ModuleName+  | IToFile (P.ModuleName, FilePath)++parseItem :: String -> DocgenOutputItem+parseItem s = case elemIndex ':' s of+  Just i ->+    s # splitAt i+        >>> first P.moduleNameFromString+        >>> second (drop 1)+        >>> IToFile+  Nothing ->+    IToStdOut (P.moduleNameFromString s)++  where+  infixr 1 #+  (#) = flip ($)++combine :: [DocgenOutputItem] -> Either String DocgenOutput+combine [] = Right EverythingToStdOut+combine (x:xs) = foldM go (initial x) xs+  where+  initial (IToStdOut m) = ToStdOut [m]+  initial (IToFile m)   = ToFiles [m]++  go (ToStdOut ms) (IToStdOut m) = Right (ToStdOut (m:ms))+  go (ToFiles ms) (IToFile m)    = Right (ToFiles (m:ms))+  go _ _ = Left "Can't mix module names and module name/file path pairs in the same invocation."++buildOptions :: (Format, [FilePath], [String]) -> IO PSCDocsOptions+buildOptions (fmt, input, mapping) =+  case parseDocgen mapping of+    Right mapping' -> return (PSCDocsOptions fmt input mapping')+    Left err -> do+      hPutStrLn stderr "psc-docs: error in --docgen option:"+      hPutStrLn stderr ("  " ++ err)+      exitFailure+ main :: IO ()-main = execParser opts >>= docgen+main = execParser opts >>= buildOptions >>= docgen   where   opts        = info (version <*> helper <*> pscDocsOptions) infoModList   infoModList = fullDesc <> headerInfo <> footerInfo-  headerInfo  = header   "psc-docs - Generate Markdown documentation from PureScript extern files"-  footerInfo  = footer $ "psc-docs " ++ showVersion Paths.version+  headerInfo  = header "psc-docs - Generate Markdown documentation from PureScript source files"+  footerInfo  = footerDoc $ Just $ PP.vcat+                  [ examples, PP.empty, PP.text ("psc-docs " ++ showVersion Paths.version) ]    version :: Parser (a -> a)   version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden++examples :: PP.Doc+examples =+  PP.vcat $ map PP.text+    [ "Examples:"+    , "  print documentation for Data.List to stdout:"+    , "    psc-docs src/**/*.purs bower_components/*/src/**/*.purs \\"+    , "      --docgen Data.List"+    , ""+    , "  write documentation for Data.List to docs/Data.List.md:"+    , "    psc-docs src/**/*.purs bower_components/*/src/**/*.purs \\"+    , "      --docgen Data.List:docs/Data.List.md"+    , ""+    , "  write documentation for Data.List to docs/Data.List.md, and"+    , "  documentation for Data.List.Lazy to docs/Data.List.Lazy.md:"+    , "    psc-docs src/**/*.purs bower_components/*/src/**/*.purs \\"+    , "      --docgen Data.List:docs/Data.List.md \\"+    , "      --docgen Data.List.Lazy:docs/Data.List.Lazy.md"+    ]

psc-docs/Tags.hs view

@@ -11,7 +11,7 @@         names (P.DataDeclaration _ name _ dcons) = P.runProperName name : consNames           where consNames = map (\(cname, _) -> P.runProperName cname) dcons         names (P.TypeDeclaration ident _) = [show ident]-        names (P.ExternDeclaration _ ident _ _) = [show ident]+        names (P.ExternDeclaration ident _) = [show ident]         names (P.TypeSynonymDeclaration name _ _) = [P.runProperName name]         names (P.TypeClassDeclaration name _ _ _) = [P.runProperName name]         names (P.TypeInstanceDeclaration name _ _ _ _) = [show name]

− psc-make/Main.hs

@@ -1,177 +0,0 @@------------------------------------------------------------------------------------ Module      :  Main--- Copyright   :  (c) Phil Freeman 2013--- License     :  MIT------ Maintainer  :  Phil Freeman <paf31@cantab.net>--- Stability   :  experimental--- Portability :------ |-----------------------------------------------------------------------------------{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TupleSections, RecordWildCards #-}--module Main where--import Control.Applicative-import Control.Monad.Except-import Control.Monad.Reader--import Data.Version (showVersion)-import Data.Traversable (traverse)--import Options.Applicative as Opts--import System.Directory-       (doesFileExist, getModificationTime, createDirectoryIfMissing)-import System.FilePath (takeDirectory)-import System.Exit (exitSuccess, exitFailure)-import System.IO.Error (tryIOError)--import qualified Language.PureScript as P-import qualified Paths_purescript as Paths---data PSCMakeOptions = PSCMakeOptions-  { pscmInput     :: [FilePath]-  , pscmOutputDir :: FilePath-  , pscmOpts      :: P.Options P.Make-  , pscmUsePrefix :: Bool-  }--data InputOptions = InputOptions-  { ioNoPrelude   :: Bool-  , ioInputFiles  :: [FilePath]-  }--readInput :: InputOptions -> IO [(Either P.RebuildPolicy FilePath, String)]-readInput InputOptions{..} = do-  content <- forM ioInputFiles $ \inFile -> (Right inFile, ) <$> readFile inFile-  return (if ioNoPrelude then content else (Left P.RebuildNever, P.prelude) : content)--newtype Make a = Make { unMake :: ReaderT (P.Options P.Make) (ExceptT String IO) a }-  deriving (Functor, Applicative, Monad, MonadIO, MonadError String, MonadReader (P.Options P.Make))--runMake :: P.Options P.Make -> Make a -> IO (Either String a)-runMake opts = runExceptT . flip runReaderT opts . unMake--makeIO :: IO a -> Make a-makeIO = Make . lift . ExceptT . fmap (either (Left . show) Right) . tryIOError--instance P.MonadMake Make where-  getTimestamp path = makeIO $ do-    exists <- doesFileExist path-    traverse (const $ getModificationTime path) $ guard exists-  readTextFile path = makeIO $ do-    putStrLn $ "Reading " ++ path-    readFile path-  writeTextFile path text = makeIO $ do-    mkdirp path-    putStrLn $ "Writing " ++ path-    writeFile path text-  progress = makeIO . putStrLn--compile :: PSCMakeOptions -> IO ()-compile (PSCMakeOptions input outputDir opts usePrefix) = do-  modules <- P.parseModulesFromFiles (either (const "") id) <$> readInput (InputOptions (P.optionsNoPrelude opts) input)-  case modules of-    Left err -> do-      print err-      exitFailure-    Right ms -> do-      e <- runMake opts $ P.make outputDir ms prefix-      case e of-        Left err -> do-          putStrLn err-          exitFailure-        Right _ -> do-          exitSuccess-  where-    prefix = if usePrefix-               then ["Generated by psc-make version " ++ showVersion Paths.version]-               else []--mkdirp :: FilePath -> IO ()-mkdirp = createDirectoryIfMissing True . takeDirectory--inputFile :: Parser FilePath-inputFile = strArgument $-     metavar "FILE"-  <> help "The input .purs file(s)"--outputDirectory :: Parser FilePath-outputDirectory = strOption $-     short 'o'-  <> long "output"-  <> Opts.value "output"-  <> showDefault-  <> help "The output directory"--noTco :: Parser Bool-noTco = switch $-     long "no-tco"-  <> help "Disable tail call optimizations"--noPrelude :: Parser Bool-noPrelude = switch $-     long "no-prelude"-  <> help "Omit the Prelude"--noMagicDo :: Parser Bool-noMagicDo = switch $-     long "no-magic-do"-  <> help "Disable the optimization that overloads the do keyword to generate efficient code specifically for the Eff monad."--noOpts :: Parser Bool-noOpts = switch $-     long "no-opts"-  <> help "Skip the optimization phase."--comments :: Parser Bool-comments = switch $-     short 'c'-  <> long "comments"-  <> help "Include comments in the generated code."--verboseErrors :: Parser Bool-verboseErrors = switch $-     short 'v'-  <> long "verbose-errors"-  <> help "Display verbose error messages"--noPrefix :: Parser Bool-noPrefix = switch $-     short 'p'-  <> long "no-prefix"-  <> help "Do not include comment header"---options :: Parser (P.Options P.Make)-options = P.Options <$> noPrelude-                    <*> noTco-                    <*> noMagicDo-                    <*> pure Nothing-                    <*> noOpts-                    <*> verboseErrors-                    <*> (not <$> comments)-                    <*> pure P.MakeOptions--pscMakeOptions :: Parser PSCMakeOptions-pscMakeOptions = PSCMakeOptions <$> many inputFile-                                <*> outputDirectory-                                <*> options-                                <*> (not <$> noPrefix)--main :: IO ()-main = execParser opts >>= compile-  where-  opts        = info (version <*> helper <*> pscMakeOptions) infoModList-  infoModList = fullDesc <> headerInfo <> footerInfo-  headerInfo  = header   "psc-make - Compiles PureScript to Javascript"-  footerInfo  = footer $ "psc-make " ++ showVersion Paths.version--  version :: Parser (a -> a)-  version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden

+ psc-publish/BoxesHelpers.hs view

@@ -0,0 +1,38 @@+module BoxesHelpers+  ( Boxes.Box+  , Boxes.nullBox+  , module BoxesHelpers+  ) where++import System.IO (hPutStr, stderr)+import qualified Text.PrettyPrint.Boxes as Boxes++width :: Int+width = 79++indentWidth :: Int+indentWidth = 2++para :: String -> Boxes.Box+para = Boxes.para Boxes.left width++indented :: Boxes.Box -> Boxes.Box+indented b = Boxes.hcat Boxes.left [Boxes.emptyBox 1 indentWidth, b]++successivelyIndented :: [String] -> Boxes.Box+successivelyIndented [] =+  Boxes.nullBox+successivelyIndented (x:xs) =+  Boxes.vcat Boxes.left [para x, indented (successivelyIndented xs)]++vcat :: [Boxes.Box] -> Boxes.Box+vcat = Boxes.vcat Boxes.left++spacer :: Boxes.Box+spacer = Boxes.emptyBox 1 1++bulletedList :: (a -> String) -> [a] -> [Boxes.Box]+bulletedList f = map (indented . para . ("* " ++) . f)++printToStderr :: Boxes.Box -> IO ()+printToStderr = hPutStr stderr . Boxes.render

+ psc-publish/ErrorsWarnings.hs view

@@ -0,0 +1,359 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module ErrorsWarnings where++import Control.Applicative ((<$>))+import Data.Aeson.BetterErrors+import Data.Version+import Data.Maybe+import Data.Monoid+import Data.Foldable (foldMap)+import Data.List (intersperse)+import Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty as NonEmpty++import qualified Data.Text as T++import Control.Exception (IOException)+import Web.Bower.PackageMeta (BowerError, PackageName, runPackageName)+import qualified Web.Bower.PackageMeta as Bower++import qualified Language.PureScript as P+import qualified Language.PureScript.Docs as D++import BoxesHelpers++-- | An error which meant that it was not possible to retrieve metadata for a+-- package.+data PackageError+  = UserError UserError+  | InternalError InternalError+  | OtherError OtherError+  deriving (Show)++data PackageWarning+  = ResolutionNotVersion PackageName+  | UndeclaredDependency PackageName+  | UnacceptableVersion (PackageName, String)+  deriving (Show)++-- | An error that should be fixed by the user.+data UserError+  = BowerJSONNotFound+  | CouldntParseBowerJSON (ParseError BowerError)+  | BowerJSONNameMissing+  | TagMustBeCheckedOut+  | AmbiguousVersions [Version] -- Invariant: should contain at least two elements+  | BadRepositoryField RepositoryFieldError+  | MissingDependencies (NonEmpty PackageName)+  | ParseAndDesugarError D.ParseDesugarError+  deriving (Show)++data RepositoryFieldError+  = RepositoryFieldMissing+  | BadRepositoryType String+  | NotOnGithub+  deriving (Show)++-- | An error that probably indicates a bug in this module.+data InternalError+  = JSONError JSONSource (ParseError BowerError)+  deriving (Show)++data JSONSource+  = FromFile FilePath+  | FromBowerList+  deriving (Show)++data OtherError+  = ProcessFailed String [String] IOException+  | IOExceptionThrown IOException+  deriving (Show)++printError :: PackageError -> IO ()+printError = printToStderr . renderError++renderError :: PackageError -> Box+renderError err =+  case err of+    UserError e ->+      vcat+        [ para (concat+          [ "There is a problem with your package, which meant that "+          , "it could not be published."+          ])+        , para "Details:"+        , indented (displayUserError e)+        ]+    InternalError e ->+      vcat+        [ para "Internal error: this is probably a bug. Please report it:"+        , indented (para "https://github.com/purescript/purescript/issues/new")+        , spacer+        , para "Details:"+        , successivelyIndented (displayInternalError e)+        ]+    OtherError e ->+      vcat+        [ para "An error occurred, and your package could not be published."+        , para "Details:"+        , indented (displayOtherError e)+        ]++displayUserError :: UserError -> Box+displayUserError e = case e of+  BowerJSONNotFound ->+    para (concat+      [ "The bower.json file was not found. Please create one, or run "+      , "`pulp init`."+      ])+  CouldntParseBowerJSON err ->+    vcat+      [ successivelyIndented+        [ "The bower.json file could not be parsed as JSON:"+        , "aeson reported: " ++ show err+        ]+      , para "Please ensure that your bower.json file is valid JSON."+      ]+  BowerJSONNameMissing ->+    vcat+      [ successivelyIndented+        [ "In bower.json:"+        , "the \"name\" key was not found."+        ]+      , para "Please give your package a name first."+      ]+  TagMustBeCheckedOut ->+      vcat+        [ para (concat+            [ "psc-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."+            ])+        , spacer+        , para "Note: tagged versions must be in one of the following forms:"+        , indented (para "* v{MAJOR}.{MINOR}.{PATCH} (example: \"v1.6.2\")")+        , indented (para "* {MAJOR}.{MINOR}.{PATCH} (example: \"1.6.2\")")+        ]+  AmbiguousVersions vs ->+    vcat $+      [ para (concat+          [ "The currently checked out commit seems to have been tagged with "+          , "more than 1 version, and I don't know which one should be used. "+          , "Please either delete some of the tags, or create a new commit "+          , "to tag the desired verson with."+          ])+      , spacer+      , para "Tags for the currently checked out commit:"+      ] ++ bulletedList showVersion vs+  BadRepositoryField err ->+    displayRepositoryError err+  MissingDependencies pkgs ->+    let singular = NonEmpty.length pkgs == 1+        pl a b = if singular then b else a+        do_          = pl "do" "does"+        dependencies = pl "dependencies" "dependency"+        them         = pl "them" "it"+    in vcat $+      [ para (concat+        [ "The following Bower ", dependencies, " ", do_, " not appear to be "+        , "installed:"+        ])+      ] +++        bulletedList runPackageName (NonEmpty.toList pkgs)+        +++      [ spacer+      , para (concat+        [ "Please install ", them, " first, by running `bower install`."+        ])+      ]+  ParseAndDesugarError (D.ParseError err) ->+    vcat+      [ para "Parse error:"+      , indented (para (show err))+      ]+  ParseAndDesugarError (D.SortModulesError err) ->+    vcat+      [ para "Error in sortModules:"+      , indented (para (P.prettyPrintMultipleErrors False err))+      ]+  ParseAndDesugarError (D.DesugarError err) ->+    vcat+      [ para "Error while desugaring:"+      , indented (para (P.prettyPrintMultipleErrors False err))+      ]++displayRepositoryError :: RepositoryFieldError -> Box+displayRepositoryError err = case err of+  RepositoryFieldMissing ->+    vcat+      [ para (concat+         [ "The 'repository' field is not present in your bower.json file. "+         , "Without this information, Pursuit would not be able to generate "+         , "source links in your package's documentation. Please add one - like "+         , "this, for example:"+         ])+      , spacer+      , indented (vcat+          [ para "\"repository\": {"+          , indented (para "\"type\": \"git\",")+          , indented (para "\"url\": \"git://github.com/purescript/purescript-prelude.git\"")+          , para "}"+          ]+        )+      ]+  BadRepositoryType ty ->+    para (concat+      [ "In your bower.json file, the repository type is currently listed as "+      , "\"" ++ ty ++ "\". Currently, only git repositories are supported. "+      , "Please publish your code in a git repository, and then update the "+      , "repository type in your bower.json file to \"git\"."+      ])+  NotOnGithub ->+    vcat+      [ para (concat+        [ "The repository url in your bower.json file does not point to a "+        , "GitHub repository. Currently, Pursuit does not support packages "+        , "which are not hosted on GitHub."+        ])+      , spacer+      , para (concat+        [ "Please update your bower.json file to point to a GitHub repository. "+        , "Alternatively, if you would prefer not to host your package on "+        , "GitHub, please open an issue:"+        ])+      , indented (para "https://github.com/purescript/purescript/issues/new")+      ]++displayInternalError :: InternalError -> [String]+displayInternalError e = case e of+  JSONError src r ->+    [ "Error in JSON " ++ displayJSONSource src ++ ":"+    , T.unpack (Bower.displayError r)+    ]++displayJSONSource :: JSONSource -> String+displayJSONSource s = case s of+  FromFile fp ->+    "in file " ++ show fp+  FromBowerList ->+    "in the output of `bower list --json --offline`"++displayOtherError :: OtherError -> Box+displayOtherError e = case e of+  ProcessFailed prog args exc ->+    successivelyIndented+      [ "While running `" ++ prog ++ " " ++ unwords args ++ "`:"+      , show exc+      ]+  IOExceptionThrown exc ->+    successivelyIndented+      [ "An IO exception occurred:", show exc ]++data CollectedWarnings = CollectedWarnings+  { resolutionNotVersions  :: [PackageName]+  , undeclaredDependencies :: [PackageName]+  , unacceptableVersions   :: [(PackageName, String)]+  }+  deriving (Show, Eq, Ord)++instance Monoid CollectedWarnings where+  mempty = CollectedWarnings mempty mempty mempty+  mappend (CollectedWarnings as bs cs) (CollectedWarnings as' bs' cs') =+    CollectedWarnings (as <> as') (bs <> bs') (cs <> cs')++collectWarnings :: [PackageWarning] -> CollectedWarnings+collectWarnings = foldMap singular+  where+  singular w = case w of+    ResolutionNotVersion pn -> CollectedWarnings [pn] [] []+    UndeclaredDependency pn -> CollectedWarnings [] [pn] []+    UnacceptableVersion t   -> CollectedWarnings [] [] [t]++renderWarnings :: [PackageWarning] -> Box+renderWarnings warns =+  let CollectedWarnings{..} = collectWarnings warns+      go toBox warns' = toBox <$> NonEmpty.nonEmpty warns'+      mboxes = [ go warnResolutionNotVersions  resolutionNotVersions+               , go warnUndeclaredDependencies undeclaredDependencies+               , go warnUnacceptableVersions   unacceptableVersions+               ]+  in case catMaybes mboxes of+       []    -> nullBox+       boxes -> vcat [ para "Warnings:"+                     , indented (vcat (intersperse spacer boxes))+                     ]++warnResolutionNotVersions :: NonEmpty PackageName -> Box+warnResolutionNotVersions pkgNames =+  let singular = NonEmpty.length pkgNames == 1+      pl a b = if singular then b else a++      packages   = pl "packages" "package"+      were       = pl "were" "was"+      anyOfThese = pl "any of these" "this"+      these      = pl "these" "this"+  in vcat $+    [ para (concat+      ["The following ", packages, " ", were, " not resolved to a version:"])+    ] +++      bulletedList runPackageName (NonEmpty.toList pkgNames)+      +++    [ spacer+    , para (concat+      ["Links to types in ", anyOfThese, " ", packages, " will not work. In "+      , "order to make links work, edit your bower.json to specify a version"+      , " or a version range for ", these, " ", packages, ", and rerun "+      , "`bower install`."+      ])+    ]++warnUndeclaredDependencies :: NonEmpty PackageName -> Box+warnUndeclaredDependencies pkgNames =+  let singular = NonEmpty.length pkgNames == 1+      pl a b = if singular then b else a++      packages     = pl "packages" "package"+      are          = pl "are" "is"+      dependencies = pl "dependencies" "a dependency"+  in vcat $+    [ para (concat+      [ "The following Bower ", packages, " ", are, " installed, but not "+      , "declared as ", dependencies, " in your bower.json file:"+      ])+    ] +++      bulletedList runPackageName (NonEmpty.toList pkgNames)++warnUnacceptableVersions :: NonEmpty (PackageName, String) -> Box+warnUnacceptableVersions pkgs =+  let singular = NonEmpty.length pkgs == 1+      pl a b = if singular then b else a++      packages'  = pl "packages'" "package's"+      packages   = pl "packages" "package"+      anyOfThese = pl "any of these" "this"+      these      = pl "these" "this"+      versions   = pl "versions" "version"+  in vcat $+    [ para (concat+      [ "The following installed Bower ", packages', " ", versions, " could "+      , "not be parsed:"+      ])+    ] +++      bulletedList showTuple (NonEmpty.toList pkgs)+      +++    [ spacer+    , para (concat+      ["Links to types in ", anyOfThese, " ", packages, " will not work. In "+      , "order to make links work, edit your bower.json to specify an "+      , "acceptable version or version range for ", these, " ", packages, ", "+      , "and rerun `bower install`."+      ])+    ]+  where+  showTuple (pkgName, tag) = runPackageName pkgName ++ "#" ++ tag++printWarnings :: [PackageWarning] -> IO ()+printWarnings = printToStderr . renderWarnings

+ psc-publish/Main.hs view

@@ -0,0 +1,286 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++import Prelude hiding (userError)++import Data.Maybe+import Data.Char (isSpace)+import Data.String (fromString)+import Data.List (stripPrefix, isSuffixOf, (\\))+import Data.List.Split (splitOn)+import Data.List.NonEmpty (NonEmpty(..))+import Data.Version+import Safe (headMay)++import qualified Data.ByteString.Lazy.Char8 as BL+import qualified Data.Text as T++import qualified Data.Aeson as A+import Data.Aeson.BetterErrors++import Control.Applicative+import Control.Category ((>>>))+import Control.Arrow ((***))+import Control.Exception (catch, try)+import Control.Monad.Trans.Except+import Control.Monad.Error.Class (MonadError(..))+import Control.Monad.Writer++import System.Directory (doesFileExist)+import System.Process (readProcess)+import System.Exit (exitFailure)+import qualified System.FilePath.Glob as Glob++import Web.Bower.PackageMeta (PackageMeta(..), BowerError(..), PackageName,+                              runPackageName, parsePackageName, Repository(..))+import qualified Web.Bower.PackageMeta as Bower++import qualified Language.PureScript.Docs as D+import Utils+import ErrorsWarnings++main :: IO ()+main = do+  pkg <- preparePackage+  BL.putStrLn (A.encode pkg)++-- | Attempt to retrieve package metadata from the current directory.+-- Calls exitFailure if no package metadata could be retrieved.+preparePackage :: IO D.UploadedPackage+preparePackage =+  runPrepareM preparePackage'+    >>= either (\e -> printError e >> exitFailure)+               handleWarnings+  where+  handleWarnings (result, warns) = do+    printWarnings warns+    return result++newtype PrepareM a =+  PrepareM { unPrepareM :: WriterT [PackageWarning] (ExceptT PackageError IO) a }+  deriving (Functor, Applicative, Monad,+            MonadWriter [PackageWarning],+            MonadError PackageError)++-- This MonadIO instance ensures that IO errors don't crash the program.+instance MonadIO PrepareM where+  liftIO act =+    lift' (try act) >>= either (otherError . IOExceptionThrown) return+    where+    lift' :: IO a -> PrepareM a+    lift' = PrepareM . lift . lift++runPrepareM :: PrepareM a -> IO (Either PackageError (a, [PackageWarning]))+runPrepareM = runExceptT . runWriterT . unPrepareM++warn :: PackageWarning -> PrepareM ()+warn w = tell [w]++userError :: UserError -> PrepareM a+userError = throwError . UserError++internalError :: InternalError -> PrepareM a+internalError = throwError . InternalError++otherError :: OtherError -> PrepareM a+otherError = throwError . OtherError++catchLeft :: Applicative f => Either a b -> (a -> f b) -> f b+catchLeft a f = either f pure a++preparePackage' :: PrepareM D.UploadedPackage+preparePackage' = do+  exists <- liftIO (doesFileExist "bower.json")+  unless exists (userError BowerJSONNotFound)++  pkgMeta <- liftIO (Bower.decodeFile "bower.json")+                    >>= flip catchLeft (userError . CouldntParseBowerJSON)+  (pkgVersionTag, pkgVersion) <- getVersionFromGitTag+  pkgGithub                   <- getBowerInfo pkgMeta+  (pkgBookmarks, pkgModules)  <- getModulesAndBookmarks++  let declaredDeps = map fst (bowerDependencies pkgMeta +++                              bowerDevDependencies pkgMeta)+  pkgResolvedDependencies     <- getResolvedDependencies declaredDeps++  let pkgUploader = D.NotYetKnown++  return D.Package{..}++getModulesAndBookmarks :: PrepareM ([D.Bookmark], [D.Module])+getModulesAndBookmarks = do+  (inputFiles, depsFiles) <- liftIO getInputAndDepsFiles+  liftIO (D.parseAndDesugar inputFiles depsFiles renderModules)+    >>= either (userError . ParseAndDesugarError) return+  where+  renderModules bookmarks modules =+    return (bookmarks, map D.convertModule modules)++getVersionFromGitTag :: PrepareM (String, Version)+getVersionFromGitTag = do+  out <- readProcess' "git" ["tag", "--list", "--points-at", "HEAD"] ""+  let vs = map trimWhitespace (lines out)+  case mapMaybe parseMay vs of+    []  -> userError TagMustBeCheckedOut+    [x] -> return x+    xs  -> userError (AmbiguousVersions (map snd xs))+  where+  trimWhitespace =+    dropWhile isSpace >>> reverse >>> dropWhile isSpace >>> reverse+  parseMay str =+    (str,) <$> D.parseVersion' (dropPrefix "v" str)+  dropPrefix prefix str =+    fromMaybe str (stripPrefix prefix str)++getBowerInfo :: PackageMeta -> PrepareM (D.GithubUser, D.GithubRepo)+getBowerInfo = either (userError . BadRepositoryField) return . tryExtract+  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)++extractGithub :: String -> Maybe (D.GithubUser, D.GithubRepo)+extractGithub =+  stripPrefix "git://github.com/"+   >>> fmap (splitOn "/")+   >=> takeTwo+   >>> fmap (D.GithubUser *** (D.GithubRepo . dropDotGit))++  where+  takeTwo :: [a] -> Maybe (a, a)+  takeTwo [x, y] = Just (x, y)+  takeTwo _ = Nothing++  dropDotGit :: String -> String+  dropDotGit str+    | ".git" `isSuffixOf` str = take (length str - 4) str+    | otherwise = str++readProcess' :: String -> [String] -> String -> PrepareM String+readProcess' prog args stdin = do+  out <- liftIO (catch (Right <$> readProcess prog args stdin)+                       (return . Left))+  either (otherError . ProcessFailed prog args) return out++data DependencyStatus+  = Missing+  | ResolvedOther String+    -- ^ Resolved, but to something other than a version. The String argument+    -- is the resolution type. The values it can take that I'm aware of are+    -- "commit" and "branch".+  | ResolvedVersion String+    -- ^ Resolved to a version. The String argument is the resolution tag (eg,+    -- "v0.1.0").+  deriving (Show, Eq)++-- Go through all bower dependencies which contain purescript code, and+-- extract their versions.+--+-- In the case where a bower dependency is taken from a particular version,+-- that's easy; take that version. In any other case (eg, a branch, or a commit+-- sha) we print a warning that documentation links will not work, and avoid+-- linking to documentation for any types from that package.+--+-- The rationale for this is: people will prefer to use a released version+-- where possible. If they are not using a released version, then this is+-- probably for a reason. However, docs are only ever available for released+-- versions. Therefore there will probably be no version of the docs which is+-- appropriate to link to, and we should omit links.+getResolvedDependencies :: [PackageName] -> PrepareM [(PackageName, Version)]+getResolvedDependencies declaredDeps = do+  depsBS <- fromString <$> readProcess' "bower" ["list", "--json", "--offline"] ""++  deps <- catchLeft (parse asBowerResolvedDependencies depsBS)+                    (internalError . JSONError FromBowerList)++  warnUndeclared declaredDeps (map fst deps)+  handleDeps deps++  where+  asBowerResolvedDependencies ::+    Parse BowerError [(PackageName, DependencyStatus)]+  asBowerResolvedDependencies =+    key "dependencies"+      (eachInObjectWithKey (parsePackageName . T.unpack) asDependencyStatus)++asDependencyStatus :: Parse e DependencyStatus+asDependencyStatus = do+  isMissing <- keyOrDefault "missing" False asBool+  if isMissing+    then+      return Missing+    else+      key "pkgMeta" $+        key "_resolution" $ do+          type_ <- key "type" asString+          case type_ of+            "version" -> ResolvedVersion <$> key "tag" asString+            other -> return (ResolvedOther other)++warnUndeclared :: [PackageName] -> [PackageName] -> PrepareM ()+warnUndeclared declared actual =+  mapM_ (warn . UndeclaredDependency) (actual \\ declared)++handleDeps ::+  [(PackageName, DependencyStatus)] -> PrepareM [(PackageName, Version)]+handleDeps deps = do+  let (missing, notVersion, installed) = partitionDeps deps+  case missing of+    (x:xs) ->+      userError (MissingDependencies (x :| xs))+    [] -> do+      mapM_ (warn . ResolutionNotVersion . fst) notVersion+      withVersions <- catMaybes <$> mapM tryExtractVersion' installed+      filterM (liftIO . isPureScript . bowerDir . fst) withVersions++  where+  partitionDeps = foldr go ([], [], [])+  go (pkgName, d) (ms, os, is) =+    case d of+      Missing           -> (pkgName : ms, os, is)+      ResolvedOther o   -> (ms, (pkgName, o) : os, is)+      ResolvedVersion v -> (ms, os, (pkgName, v) : is)++  bowerDir pkgName = "bower_components/" ++ runPackageName pkgName++  -- Try to extract a version, and warn if unsuccessful.+  tryExtractVersion' pair =+    maybe (warn (UnacceptableVersion pair) >> return Nothing)+          (return . Just)+          (tryExtractVersion pair)++tryExtractVersion :: (PackageName, String) -> Maybe (PackageName, Version)+tryExtractVersion (pkgName, tag) =+  let tag' = fromMaybe tag (stripPrefix "v" tag)+  in  (pkgName,) <$> D.parseVersion' tag'++-- | Returns whether it looks like there is a purescript package checked out+-- in the given directory.+isPureScript :: FilePath -> IO Bool+isPureScript dir = do+  files <- Glob.globDir1 purescriptSourceFiles dir+  return (not (null files))++getInputAndDepsFiles :: IO ([FilePath], [(PackageName, FilePath)])+getInputAndDepsFiles = do+  inputFiles <- globRelative purescriptSourceFiles+  depsFiles' <- globRelative purescriptDepsFiles+  return (inputFiles, mapMaybe withPackageName depsFiles')++withPackageName :: FilePath -> Maybe (PackageName, FilePath)+withPackageName fp = (,fp) <$> getPackageName fp++getPackageName :: FilePath -> Maybe PackageName+getPackageName fp = do+  let xs = splitOn "/" fp+  ys <- stripPrefix ["bower_components"] xs+  y <- headMay ys+  case Bower.mkPackageName y of+    Right name -> Just name+    Left _ -> Nothing

+ psc-publish/Utils.hs view

@@ -0,0 +1,22 @@++module Utils where++import Data.List+import Data.Maybe+import System.Directory+import qualified System.FilePath.Glob as Glob++-- | Glob relative to the current directory, and produce relative pathnames.+globRelative :: Glob.Pattern -> IO [FilePath]+globRelative pat = do+  currentDir <- getCurrentDirectory+  filesAbsolute <- Glob.globDir1 pat currentDir+  return (mapMaybe (stripPrefix (currentDir ++ "/")) filesAbsolute)++-- | Glob pattern for PureScript source files.+purescriptSourceFiles :: Glob.Pattern+purescriptSourceFiles = Glob.compile "src/**/*.purs"++-- | Glob pattern for PureScript dependency files.+purescriptDepsFiles :: Glob.Pattern+purescriptDepsFiles = Glob.compile "bower_components/*/src/**/*.purs"

psc/Main.hs view

@@ -12,160 +12,134 @@ -- ----------------------------------------------------------------------------- -{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TupleSections, RecordWildCards #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-}  module Main where  import Control.Applicative-import Control.Monad.Except-import Control.Monad.Reader+import Control.Monad+import Control.Monad.Error.Class (MonadError(..))+import Control.Monad.Writer -import Data.Maybe (fromMaybe) import Data.Version (showVersion)+import qualified Data.Map as M  import Options.Applicative as Opts-import System.Directory (createDirectoryIfMissing)-import System.FilePath (takeDirectory)+ import System.Exit (exitSuccess, exitFailure) import System.IO (hPutStrLn, stderr)+import System.FilePath.Glob (glob)  import qualified Language.PureScript as P import qualified Paths_purescript as Paths +import Make -data PSCOptions = PSCOptions-  { pscInput     :: [FilePath]-  , pscOpts      :: P.Options P.Compile-  , pscStdIn     :: Bool-  , pscOutput    :: Maybe FilePath-  , pscExterns   :: Maybe FilePath-  , pscUsePrefix :: Bool+data PSCMakeOptions = PSCMakeOptions+  { pscmInput        :: [FilePath]+  , pscmForeignInput :: [FilePath]+  , pscmOutputDir    :: FilePath+  , pscmOpts         :: P.Options+  , pscmUsePrefix    :: Bool   }  data InputOptions = InputOptions-  { ioNoPrelude   :: Bool-  , ioUseStdIn    :: Bool-  , ioInputFiles  :: [FilePath]+  { ioInputFiles  :: [FilePath]   } -readInput :: InputOptions -> IO [(Maybe FilePath, String)]-readInput InputOptions{..}-  | ioUseStdIn = return . (Nothing ,) <$> getContents-  | otherwise = do content <- forM ioInputFiles $ \inFile -> (Just inFile, ) <$> readFile inFile-                   return (if ioNoPrelude then content else (Nothing, P.prelude) : content)--compile :: PSCOptions -> IO ()-compile (PSCOptions input opts stdin output externs usePrefix) = do-  modules <- P.parseModulesFromFiles (fromMaybe "") <$> readInput (InputOptions (P.optionsNoPrelude opts) stdin input)-  case modules of-    Left err -> do-      hPutStrLn stderr $ show err+compile :: PSCMakeOptions -> IO ()+compile (PSCMakeOptions inputGlob inputForeignGlob outputDir opts usePrefix) = do+  input <- concat <$> mapM glob inputGlob+  when (null input) $ do+    hPutStrLn stderr "psc: No input files."+    exitFailure+  moduleFiles <- readInput (InputOptions input)+  inputForeign <- concat <$> mapM glob inputForeignGlob+  foreignFiles <- forM inputForeign (\inFile -> (inFile,) <$> readFile inFile)+  case runWriterT (parseInputs moduleFiles foreignFiles) of+    Left errs -> do+      hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)       exitFailure-    Right ms -> do-      case P.compile (map snd ms) prefix `runReaderT` opts of-        Left err -> do-          hPutStrLn stderr err+    Right ((ms, foreigns), warnings) -> do+      when (P.nonEmpty warnings) $+        hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings)+      let filePathMap = M.fromList $ map (\(fp, P.Module _ mn _ _) -> (mn, fp)) ms+          makeActions = buildMakeActions outputDir filePathMap foreigns usePrefix+      e <- runMake opts $ P.make makeActions ms+      case e of+        Left errs -> do+          hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)           exitFailure-        Right (js, exts, _) -> do-          case output of-            Just path -> mkdirp path >> writeFile path js-            Nothing -> putStrLn js-          case externs of-            Just path -> mkdirp path >> writeFile path exts-            Nothing -> return ()+        Right (_, warnings') -> do+          when (P.nonEmpty warnings') $+            putStrLn (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings')           exitSuccess-  where-  prefix = if usePrefix-              then ["Generated by psc version " ++ showVersion Paths.version]-              else [] -mkdirp :: FilePath -> IO ()-mkdirp = createDirectoryIfMissing True . takeDirectory--codeGenModule :: Parser String-codeGenModule = strOption $-     long "codegen"-  <> help "A list of modules for which Javascript and externs should be generated. This argument can be used multiple times."--dceModule :: Parser String-dceModule = strOption $-     short 'm'-  <> long "module"-  <> help "Enables dead code elimination, all code which is not a transitive dependency of a specified module will be removed. This argument can be used multiple times."+readInput :: InputOptions -> IO [(Either P.RebuildPolicy FilePath, String)]+readInput InputOptions{..} = forM ioInputFiles $ \inFile -> (Right inFile, ) <$> readFile inFile -browserNamespace :: Parser String-browserNamespace = strOption $-     long "browser-namespace"-  <> Opts.value "PS"-  <> showDefault-  <> help "Specify the namespace that PureScript modules will be exported to when running in the browser."+parseInputs :: (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m)+            => [(Either P.RebuildPolicy FilePath, String)]+            -> [(FilePath, P.ForeignJS)]+            -> m ([(Either P.RebuildPolicy FilePath, P.Module)], M.Map P.ModuleName (FilePath, P.ForeignJS))+parseInputs modules foreigns =+  (,) <$> P.parseModulesFromFiles (either (const "") id) modules+      <*> P.parseForeignModulesFromFiles foreigns -verboseErrors :: Parser Bool-verboseErrors = switch $-     short 'v'-  <> long "verbose-errors"-  <> help "Display verbose error messages"+inputFile :: Parser FilePath+inputFile = strArgument $+     metavar "FILE"+  <> help "The input .purs file(s)" -noOpts :: Parser Bool-noOpts = switch $-     long "no-opts"-  <> help "Skip the optimization phase."+inputForeignFile :: Parser FilePath+inputForeignFile = strOption $+     short 'f'+  <> long "ffi"+  <> help "The input .js file(s) providing foreign import implementations" -runMain :: Parser (Maybe String)-runMain = optional $ noArgs <|> withArgs-  where-  defaultVal = "Main"-  noArgs     = flag' defaultVal (long "main")-  withArgs   = strOption $-        long "main"-     <> help (concat [-            "Generate code to run the main method in the specified module. ",-            "(no argument: \"", defaultVal, "\")"-        ])+outputDirectory :: Parser FilePath+outputDirectory = strOption $+     short 'o'+  <> long "output"+  <> Opts.value "output"+  <> showDefault+  <> help "The output directory" -noMagicDo :: Parser Bool-noMagicDo = switch $-     long "no-magic-do"-  <> help "Disable the optimization that overloads the do keyword to generate efficient code specifically for the Eff monad."+requirePath :: Parser (Maybe FilePath)+requirePath = optional $ strOption $+     short 'r'+  <> long "require-path"+  <> help "The path prefix to use for require() calls in the generated JavaScript"  noTco :: Parser Bool noTco = switch $      long "no-tco"   <> help "Disable tail call optimizations" -noPrelude :: Parser Bool-noPrelude = switch $-     long "no-prelude"-  <> help "Omit the Prelude"+noMagicDo :: Parser Bool+noMagicDo = switch $+     long "no-magic-do"+  <> help "Disable the optimization that overloads the do keyword to generate efficient code specifically for the Eff monad" +noOpts :: Parser Bool+noOpts = switch $+     long "no-opts"+  <> help "Skip the optimization phase"+ comments :: Parser Bool comments = switch $      short 'c'   <> long "comments"-  <> help "Include comments in the generated code."--useStdIn :: Parser Bool-useStdIn = switch $-     short 's'-  <> long "stdin"-  <> help "Read from standard input"--inputFile :: Parser FilePath-inputFile = strArgument $-     metavar "FILE"-  <> help "The input .purs file(s)"--outputFile :: Parser (Maybe FilePath)-outputFile = optional . strOption $-     short 'o'-  <> long "output"-  <> help "The output .js file"+  <> help "Include comments in the generated code" -externsFile :: Parser (Maybe FilePath)-externsFile = optional . strOption $-     short 'e'-  <> long "externs"-  <> help "The output .e.purs file"+verboseErrors :: Parser Bool+verboseErrors = switch $+     short 'v'+  <> long "verbose-errors"+  <> help "Display verbose error messages"  noPrefix :: Parser Bool noPrefix = switch $@@ -173,37 +147,30 @@   <> long "no-prefix"   <> help "Do not include comment header" -options :: Parser (P.Options P.Compile)-options = P.Options <$> noPrelude-                    <*> noTco++options :: Parser P.Options+options = P.Options <$> noTco                     <*> noMagicDo-                    <*> runMain+                    <*> pure Nothing                     <*> noOpts                     <*> verboseErrors                     <*> (not <$> comments)-                    <*> additionalOptions-  where-  additionalOptions =-    P.CompileOptions <$> browserNamespace-                     <*> many dceModule-                     <*> many codeGenModule--pscOptions :: Parser PSCOptions-pscOptions = PSCOptions <$> many inputFile-                        <*> options-                        <*> useStdIn-                        <*> outputFile-                        <*> externsFile-                        <*> (not <$> noPrefix)+                    <*> requirePath+                    +pscMakeOptions :: Parser PSCMakeOptions+pscMakeOptions = PSCMakeOptions <$> many inputFile+                                <*> many inputForeignFile+                                <*> outputDirectory+                                <*> options+                                <*> (not <$> noPrefix)  main :: IO () main = execParser opts >>= compile   where-  opts        = info (version <*> helper <*> pscOptions) infoModList+  opts        = info (version <*> helper <*> pscMakeOptions) infoModList   infoModList = fullDesc <> headerInfo <> footerInfo   headerInfo  = header   "psc - Compiles PureScript to Javascript"   footerInfo  = footer $ "psc " ++ showVersion Paths.version    version :: Parser (a -> a)   version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden-

+ psc/Make.hs view

@@ -0,0 +1,140 @@+-----------------------------------------------------------------------------+--+-- Module      :  Make+-- Copyright   :  (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors+-- License     :  MIT+--+-- Maintainer  :  Phil Freeman <paf31@cantab.net>+-- Stability   :  experimental+-- Portability :+--+-- |+--+-----------------------------------------------------------------------------++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TupleSections #-}++module Make+  ( Make(..)+  , runMake+  , buildMakeActions+  ) where++import Control.Applicative+import Control.Monad+import Control.Monad.Error.Class (MonadError(..))+import Control.Monad.Trans.Except+import Control.Monad.Reader+import Control.Monad.Writer++import Data.Maybe (fromMaybe)+import Data.Time.Clock+import Data.Traversable (traverse)+import Data.Version (showVersion)+import qualified Data.Map as M++import System.Directory+       (doesFileExist, getModificationTime, createDirectoryIfMissing)+import System.FilePath ((</>), takeDirectory)+import System.IO.Error (tryIOError)++import qualified Language.PureScript as P+import qualified Language.PureScript.CodeGen.JS as J+import qualified Language.PureScript.CoreFn as CF+import qualified Paths_purescript as Paths++newtype Make a = Make { unMake :: ReaderT P.Options (WriterT P.MultipleErrors (ExceptT P.MultipleErrors IO)) a }+  deriving (Functor, Applicative, Monad, MonadIO, MonadError P.MultipleErrors, MonadWriter P.MultipleErrors, MonadReader P.Options)++runMake :: P.Options -> Make a -> IO (Either P.MultipleErrors (a, P.MultipleErrors))+runMake opts = runExceptT . runWriterT . flip runReaderT opts . unMake++makeIO :: (IOError -> P.ErrorMessage) -> IO a -> Make a+makeIO f io = do+  e <- liftIO $ tryIOError io+  either (throwError . P.singleError . f) return e++-- Traverse (Either e) instance (base 4.7)+traverseEither :: Applicative f => (a -> f b) -> Either e a -> f (Either e b)+traverseEither _ (Left x) = pure (Left x)+traverseEither f (Right y) = Right <$> f y++buildMakeActions :: FilePath+                 -> M.Map P.ModuleName (Either P.RebuildPolicy String)+                 -> M.Map P.ModuleName (FilePath, P.ForeignJS)+                 -> Bool+                 -> P.MakeActions Make+buildMakeActions outputDir filePathMap foreigns usePrefix =+  P.MakeActions getInputTimestamp getOutputTimestamp readExterns codegen progress+  where++  getInputTimestamp :: P.ModuleName -> Make (Either P.RebuildPolicy (Maybe UTCTime))+  getInputTimestamp mn = do+    let path = fromMaybe (error "Module has no filename in 'make'") $ M.lookup mn filePathMap+    e1 <- traverseEither getTimestamp path+    fPath <- maybe (return Nothing) (getTimestamp . fst) $ M.lookup mn foreigns+    return $ fmap (max fPath) e1++  getOutputTimestamp :: P.ModuleName -> Make (Maybe UTCTime)+  getOutputTimestamp mn = do+    let filePath = P.runModuleName mn+        jsFile = outputDir </> filePath </> "index.js"+        externsFile = outputDir </> filePath </> "externs.purs"+    min <$> getTimestamp jsFile <*> getTimestamp externsFile++  readExterns :: P.ModuleName -> Make (FilePath, String)+  readExterns mn = do+    let path = outputDir </> P.runModuleName mn </> "externs.purs"+    (path, ) <$> readTextFile path++  codegen :: CF.Module CF.Ann -> P.Environment -> P.SupplyVar -> P.Externs -> Make ()+  codegen m _ nextVar exts = do+    let mn = CF.moduleName m+    foreignInclude <- case mn `M.lookup` foreigns of+      Just (path, _)+        | not $ requiresForeign m -> do+            tell $ P.errorMessage $ P.UnnecessaryFFIModule mn path+            return Nothing+        | otherwise -> return $ Just $ J.JSApp (J.JSVar "require") [J.JSStringLiteral "./foreign"]+      Nothing | requiresForeign m -> throwError . P.errorMessage $ P.MissingFFIModule mn+              | otherwise -> return Nothing+    pjs <- P.evalSupplyT nextVar $ P.prettyPrintJS <$> J.moduleToJs m foreignInclude+    let filePath = P.runModuleName mn+        jsFile = outputDir </> filePath </> "index.js"+        externsFile = outputDir </> filePath </> "externs.purs"+        foreignFile = outputDir </> filePath </> "foreign.js"+        prefix = ["Generated by psc version " ++ showVersion Paths.version | usePrefix]+        js = unlines $ map ("// " ++) prefix ++ [pjs]+    writeTextFile jsFile js+    maybe (return ()) (writeTextFile foreignFile . snd) $ mn `M.lookup` foreigns+    writeTextFile externsFile exts++  requiresForeign :: CF.Module a -> Bool+  requiresForeign = not . null . CF.moduleForeign++  getTimestamp :: FilePath -> Make (Maybe UTCTime)+  getTimestamp path = makeIO (const (P.SimpleErrorWrapper $ P.CannotGetFileInfo path)) $ do+    exists <- doesFileExist path+    traverse (const $ getModificationTime path) $ guard exists++  readTextFile :: FilePath -> Make String+  readTextFile path = do+    verboseErrorsEnabled <- asks P.optionsVerboseErrors+    makeIO (const (P.SimpleErrorWrapper $ P.CannotReadFile path)) $ do+      when verboseErrorsEnabled $ putStrLn $ "Reading " ++ path+      readFile path++  writeTextFile :: FilePath -> String -> Make ()+  writeTextFile path text = makeIO (const (P.SimpleErrorWrapper $ P.CannotWriteFile path)) $ do+    mkdirp path+    putStrLn $ "Writing " ++ path+    writeFile path text+    where+    mkdirp :: FilePath -> IO ()+    mkdirp = createDirectoryIfMissing True . takeDirectory++  progress :: String -> Make ()+  progress = liftIO . putStrLn

− psci/Commands.hs

@@ -1,78 +0,0 @@------------------------------------------------------------------------------------ Module      :  Commands--- Copyright   :  (c) Phil Freeman 2014--- License     :  MIT------ Maintainer  :  Phil Freeman <paf31@cantab.net>--- Stability   :  experimental--- Portability :------ |--- Commands for PSCI.-----------------------------------------------------------------------------------module Commands where--import Language.PureScript---- |--- Valid Meta-commands for PSCI----data Command-  -- |-  -- A purescript expression-  ---  = Expression Expr-  -- |-  -- Show the help command-  ---  | Help-  -- |-  -- Import a module from a loaded file-  ---  | Import ImportedModule-  -- |-  -- Browse a module-  ---  | Browse ModuleName-  -- |-  -- Load a file for use with importing-  ---  | LoadFile FilePath-  -- |-  -- Exit PSCI-  ---  | Quit-  -- |-  -- Reset the state of the REPL-  ---  | Reset-  -- |-  -- Add some declarations to the current evaluation context.-  ---  | Decls [Declaration]-  -- |-  -- Find the type of an expression-  ---  | TypeOf Expr-  -- |-  -- Find the kind of an expression-  ---  | KindOf Type-  -- |-  -- Show command-  ---  | Show String---- | All of the data that is contained by an ImportDeclaration in the AST.--- That is:------ * A module name, the name of the module which is being imported--- * An ImportDeclarationType which specifies whether there is an explicit---   import list, a hiding list, or neither.--- * If the module is imported qualified, its qualified name in the importing---   module. Otherwise, Nothing.----type ImportedModule = (ModuleName, ImportDeclarationType, Maybe ModuleName)

+ psci/Completion.hs view

@@ -0,0 +1,224 @@+module Completion where++import Data.Maybe (mapMaybe)+import Data.List (nub, nubBy, sortBy, isPrefixOf, stripPrefix)+import Data.Char (isUpper)+import Data.Function (on)+import Data.Traversable (traverse)++import Control.Applicative ((<$>), (<*>))+import Control.Monad.Trans.Reader (asks, runReaderT, ReaderT)+import Control.Monad.Trans.State.Strict++import System.Console.Haskeline++import qualified Language.PureScript as P+import qualified Language.PureScript.Names as N++import qualified Directive as D+import Types++-- Completions may read the state, but not modify it.+type CompletionM = ReaderT PSCiState IO++-- Lift a `CompletionM` action to a `StateT PSCiState IO` one.+liftCompletionM :: CompletionM a -> StateT PSCiState IO a+liftCompletionM act = StateT (\s -> (\a -> (a, s)) <$> runReaderT act s)++-- Haskeline completions++data CompletionContext+  = CtxDirective String+  | CtxFilePath String+  | CtxModule+  | CtxIdentifier+  | CtxType+  | CtxFixed String+  deriving (Show)++-- |+-- Loads module, function, and file completions.+--+completion :: CompletionFunc (StateT PSCiState IO)+completion = liftCompletionM . completion'++completion' :: CompletionFunc CompletionM+completion' = completeWordWithPrev Nothing " \t\n\r" findCompletions++-- |+-- Decide what kind of completion we need based on input. This function expects+-- a list of complete words (to the left of the cursor) as the first argument,+-- and the current word as the second argument.+completionContext :: [String] -> String -> [CompletionContext]+completionContext [] _ = [CtxDirective "", CtxIdentifier, CtxFixed "import"]+completionContext ws w | headSatisfies (":" `isPrefixOf`) ws = completeDirective ws w+completionContext ws w | headSatisfies (== "import") ws = completeImport ws w+completionContext _ _ = [CtxIdentifier]++completeDirective :: [String] -> String -> [CompletionContext]+completeDirective ws w =+  case ws of+    []    -> [CtxDirective w]+    [dir] -> case D.directivesFor <$> stripPrefix ":" dir of+                -- only offer completions if the directive is unambiguous+                Just [dir'] -> directiveArg w dir'+                _           -> []++    -- All directives take exactly one argument. If we haven't yet matched,+    -- that means one argument has already been supplied. So don't complete+    -- any others.+    _     -> []++directiveArg :: String -> Directive -> [CompletionContext]+directiveArg _ Browse      = [CtxModule]+directiveArg w Load        = [CtxFilePath w]+directiveArg w Foreign     = [CtxFilePath w]+directiveArg _ Quit        = []+directiveArg _ Reset       = []+directiveArg _ Help        = []+directiveArg _ Show        = map CtxFixed replQueryStrings+directiveArg _ Type        = [CtxIdentifier]+directiveArg _ Kind        = [CtxType]++completeImport :: [String] -> String -> [CompletionContext]+completeImport ws w' =+  case (ws, w') of+    (["import"], w) | headSatisfies isUpper w -> [CtxModule]+    (["import"], _)                           -> [CtxModule, CtxFixed "qualified"]+    (["import", "qualified"], _)              -> [CtxModule]+    _                                         -> []++headSatisfies :: (a -> Bool) -> [a] -> Bool+headSatisfies p str =+  case str of+    (c:_)  -> p c+    _     -> False++-- | Callback for Haskeline's `completeWordWithPrev`.+-- Expects:+--   * Line contents to the left of the word, reversed+--   * Word to be completed+findCompletions :: String -> String -> CompletionM [Completion]+findCompletions prev word = do+  let ctx = completionContext (words (reverse prev)) word+  completions <- concat <$> traverse getCompletions ctx+  return $ sortBy directivesFirst completions+  where+  getCompletions :: CompletionContext -> CompletionM [Completion]+  getCompletions = fmap (mapMaybe (either (prefixedBy word) Just)) . getCompletion++  prefixedBy :: String -> String -> Maybe Completion+  prefixedBy w cand = if w `isPrefixOf` cand+                        then Just (simpleCompletion cand)+                        else Nothing++getCompletion :: CompletionContext -> CompletionM [Either String Completion]+getCompletion ctx =+  case ctx of+    CtxFilePath f        -> map Right <$> listFiles f+    CtxModule            -> map Left <$> getModuleNames+    CtxIdentifier        -> map Left <$> ((++) <$> getIdentNames <*> getDctorNames)+    CtxType              -> map Left <$> getTypeNames+    CtxFixed str         -> return [Left str]+    CtxDirective d       -> return (map Left (completeDirectives d))++  where+  completeDirectives :: String -> [String]+  completeDirectives = map (':' :) . D.directiveStringsFor+++getLoadedModules :: CompletionM [P.Module]+getLoadedModules = asks (map snd . psciLoadedModules)++getImportedModules :: CompletionM [ImportedModule]+getImportedModules = asks psciImportedModules++getModuleNames :: CompletionM [String]+getModuleNames = moduleNames <$> getLoadedModules++mapLoadedModulesAndQualify :: (Show a) => (P.Module -> [(a, P.Declaration)]) -> CompletionM [String]+mapLoadedModulesAndQualify f = do+  ms <- getLoadedModules+  let argPairs = do m <- ms+                    fm <- f m+                    return (m, fm)+  concat <$> traverse (uncurry getAllQualifications) argPairs++getIdentNames :: CompletionM [String]+getIdentNames = mapLoadedModulesAndQualify identNames++getDctorNames :: CompletionM [String]+getDctorNames = mapLoadedModulesAndQualify dctorNames++getTypeNames :: CompletionM [String]+getTypeNames = mapLoadedModulesAndQualify typeDecls++-- | Given a module and a declaration in that module, return all possible ways+-- it could have been referenced given the current PSCiState - including fully+-- qualified, qualified using an alias, and unqualified.+getAllQualifications :: (Show a) => P.Module -> (a, P.Declaration) -> CompletionM [String]+getAllQualifications m (declName, decl) = do+  imports <- getAllImportsOf m+  let fullyQualified = qualifyWith (Just (P.getModuleName m))+  let otherQuals = nub (concatMap qualificationsUsing imports)+  return $ fullyQualified : otherQuals+  where+  qualifyWith mMod = show (P.Qualified mMod declName)+  referencedBy refs = P.isExported (Just refs) decl++  qualificationsUsing (_, importType, asQ') =+    let q = qualifyWith asQ'+    in case importType of+          P.Implicit      -> [q]+          P.Explicit refs -> if referencedBy refs+                               then [q]+                               else []+          P.Hiding refs   -> if referencedBy refs+                               then []+                               else [q]+++-- | Returns all the ImportedModule values referring to imports of a particular+-- module.+getAllImportsOf :: P.Module -> CompletionM [ImportedModule]+getAllImportsOf = asks . allImportsOf++nubOnFst :: Eq a => [(a, b)] -> [(a, b)]+nubOnFst = nubBy ((==) `on` fst)++typeDecls :: P.Module -> [(N.ProperName, P.Declaration)]+typeDecls = mapMaybe getTypeName . filter P.isDataDecl . P.exportedDeclarations+  where+  getTypeName :: P.Declaration -> Maybe (N.ProperName, P.Declaration)+  getTypeName d@(P.TypeSynonymDeclaration name _ _) = Just (name, d)+  getTypeName d@(P.DataDeclaration _ name _ _) = Just (name, d)+  getTypeName (P.PositionedDeclaration _ _ d) = getTypeName d+  getTypeName _ = Nothing++identNames :: P.Module -> [(N.Ident, P.Declaration)]+identNames = nubOnFst . mapMaybe getDeclName . P.exportedDeclarations+  where+  getDeclName :: P.Declaration -> Maybe (P.Ident, P.Declaration)+  getDeclName d@(P.ValueDeclaration ident _ _ _)  = Just (ident, d)+  getDeclName d@(P.ExternDeclaration ident _) = Just (ident, d)+  getDeclName (P.PositionedDeclaration _ _ d) = getDeclName d+  getDeclName _ = Nothing++dctorNames :: P.Module -> [(N.ProperName, P.Declaration)]+dctorNames = nubOnFst . concatMap go . P.exportedDeclarations+  where+  go :: P.Declaration -> [(N.ProperName, P.Declaration)]+  go decl@(P.DataDeclaration _ _ _ ctors) = map (\n -> (n, decl)) (map fst ctors)+  go (P.PositionedDeclaration _ _ d) = go d+  go _ = []++moduleNames :: [P.Module] -> [String]+moduleNames ms = nub [show moduleName | P.Module _ moduleName _ _ <- ms]++directivesFirst :: Completion -> Completion -> Ordering+directivesFirst (Completion _ d1 _) (Completion _ d2 _) = go d1 d2+  where+  go (':' : xs) (':' : ys) = compare xs ys+  go (':' : _) _ = LT+  go _ (':' : _) = GT+  go xs ys = compare xs ys

psci/Directive.hs view

@@ -15,65 +15,101 @@  module Directive where -import Data.List (nub, isPrefixOf)+import Data.Maybe (fromJust, listToMaybe)+import Data.List (isPrefixOf)+import Data.Tuple (swap) -data Directive-  = Help-  | Quit-  | Reset-  | Browse-  | Load-  | Type-  | Kind-  | Show-  deriving Eq+import Types  -- |--- Maps given directive to relating command strings.+-- List of all avaliable directives. ---commands :: Directive -> [String]-commands Help = ["?", "help"]-commands Quit = ["quit"]-commands Reset = ["reset"]-commands Browse = ["browse"]-commands Load = ["load", "module"]-commands Type = ["type"]-commands Kind = ["kind"]-commands Show = ["show"]+directives :: [Directive]+directives = map fst directiveStrings  -- |--- Tries to parse given string into a directive.+-- A mapping of directives to the different strings that can be used to invoke+-- them. ---parseDirective :: String -> Maybe Directive-parseDirective cmd =-  case filter (matches . snd) mapping of-    [directive] -> Just $ fst directive-    _ -> Nothing+directiveStrings :: [(Directive, [String])]+directiveStrings =+    [ (Help   , ["?", "help"])+    , (Quit   , ["quit"])+    , (Reset  , ["reset"])+    , (Browse , ["browse"])+    , (Load   , ["load", "module"])+    , (Foreign, ["foreign"])+    , (Type   , ["type"])+    , (Kind   , ["kind"])+    , (Show   , ["show"])+    ]++-- |+-- Like directiveStrings, but the other way around.+--+directiveStrings' :: [(String, Directive)]+directiveStrings' = concatMap go directiveStrings   where-  mapping :: [(Directive, [String])]-  mapping = zip directives (map commands directives)+  go (dir, strs) = map (\s -> (s, dir)) strs -  matches :: [String] -> Bool-  matches = any (cmd `isPrefixOf`)+-- |+-- List of all directive strings.+--+strings :: [String]+strings = concatMap snd directiveStrings  -- |+-- Returns all possible string representations of a directive.+--+stringsFor :: Directive -> [String]+stringsFor d = fromJust (lookup d directiveStrings)++-- |+-- Returns the default string representation of a directive.+--+stringFor :: Directive -> String+stringFor = head . stringsFor++-- |+-- Returns the list of directives which could be expanded from the string+-- argument, together with the string alias that matched.+--+directivesFor' :: String -> [(Directive, String)]+directivesFor' str = go directiveStrings'+  where+  go = map swap . filter ((str `isPrefixOf`) . fst)++directivesFor :: String -> [Directive]+directivesFor = map fst . directivesFor'++directiveStringsFor :: String -> [String]+directiveStringsFor = map snd . directivesFor'++parseDirective :: String -> Maybe Directive+parseDirective = listToMaybe . directivesFor++-- |+-- True if the given directive takes an argument, false otherwise.+hasArgument :: Directive -> Bool+hasArgument Help = False+hasArgument Quit = False+hasArgument Reset = False+hasArgument _ = True++-- | -- The help menu. -- help :: [(Directive, String, String)] help =-  [ (Help,   "",         "Show this help menu")-  , (Quit,   "",         "Quit PSCi")-  , (Reset,  "",         "Reset")-  , (Browse, "<module>", "Browse <module>")-  , (Load,   "<file>",   "Load <file> for importing")-  , (Type,   "<expr>",   "Show the type of <expr>")-  , (Kind,   "<type>",   "Show the kind of <type>")-  , (Show,   "import",   "Show imported modules")-  , (Show,   "loaded",   "Show loaded modules")+  [ (Help,    "",         "Show this help menu")+  , (Quit,    "",         "Quit PSCi")+  , (Reset,   "",         "Discard all imported modules and declared bindings")+  , (Browse,  "<module>", "See all functions in <module>")+  , (Load,    "<file>",   "Load <file> for importing")+  , (Foreign, "<file>",   "Load foreign module <file>")+  , (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")   ] --- |--- List of all avaliable directives.----directives :: [Directive]-directives = nub . map (\(dir, _, _) -> dir) $ help

+ psci/IO.hs view

@@ -0,0 +1,21 @@+-----------------------------------------------------------------------------+--+-- Module      :  IO+-- Copyright   :  (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors+-- License     :  MIT+--+-- Maintainer  :  Phil Freeman <paf31@cantab.net>+-- Stability   :  experimental+-- Portability :+--+-- |+--+-----------------------------------------------------------------------------++module IO where++import System.Directory (createDirectoryIfMissing)+import System.FilePath (takeDirectory)++mkdirp :: FilePath -> IO ()+mkdirp = createDirectoryIfMissing True . takeDirectory

− psci/Main.hs

@@ -1,702 +0,0 @@------------------------------------------------------------------------------------ Module      :  Main--- Copyright   :  (c) Phil Freeman 2013--- License     :  MIT------ Maintainer  :  Phil Freeman <paf31@cantab.net>--- Stability   :  experimental--- Portability :------ |--- PureScript Compiler Interactive.-----------------------------------------------------------------------------------{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DoAndIfThenElse #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE RecordWildCards #-}--module Main where--import Data.Foldable (traverse_)-import Data.List (intercalate, isPrefixOf, nub, sortBy, sort)-import Data.Maybe (mapMaybe)-import Data.Traversable (traverse)-import Data.Version (showVersion)-import Data.Char (isSpace)-import qualified Data.Map as M--import Control.Applicative-import Control.Monad-import Control.Monad.Except (ExceptT(..), MonadError, runExceptT)-import Control.Monad.Reader (MonadReader, ReaderT, runReaderT)-import Control.Monad.Trans.Class-import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)-import Control.Monad.Trans.State.Strict-import qualified Control.Monad.Trans.State.Lazy as L--import Options.Applicative as Opts--import System.Console.Haskeline-import System.Directory (createDirectoryIfMissing, getModificationTime, doesFileExist, findExecutable, getHomeDirectory, getCurrentDirectory)-import System.Exit-import System.FilePath (pathSeparator, takeDirectory, (</>), isPathSeparator)-import System.IO.Error (tryIOError)-import System.Process (readProcessWithExitCode)--import qualified Text.Parsec as Par (ParseError)--import qualified Language.PureScript as P-import qualified Language.PureScript.AST as D-import qualified Language.PureScript.Names as N-import qualified Paths_purescript as Paths--import qualified Commands as C-import qualified Directive as D-import Parser--data PSCiOptions = PSCiOptions-  { psciMultiLineMode  :: Bool-  , psciInputFile      :: [FilePath]-  , psciInputNodeFlags :: [String]-  }---- |--- The PSCI state.--- Holds a list of imported modules, loaded files, and partial let bindings.--- The let bindings are partial,--- because it makes more sense to apply the binding to the final evaluated expression.----data PSCiState = PSCiState-  { psciImportedFilenames   :: [FilePath]-  , psciImportedModules     :: [C.ImportedModule]-  , psciLoadedModules       :: [(Either P.RebuildPolicy FilePath, P.Module)]-  , psciLetBindings         :: [P.Declaration]-  , psciNodeFlags           :: [String]-  }--psciImportedModuleNames :: PSCiState -> [P.ModuleName]-psciImportedModuleNames (PSCiState{psciImportedModules = is}) =-  map (\(mn, _, _) -> mn) is---- State helpers---- |--- Updates the state to have more imported modules.----updateImportedFiles :: FilePath -> PSCiState -> PSCiState-updateImportedFiles filename st = st { psciImportedFilenames = filename : psciImportedFilenames st }---- |--- Updates the state to have more imported modules.----updateImportedModules :: C.ImportedModule -> PSCiState -> PSCiState-updateImportedModules im st = st { psciImportedModules = im : psciImportedModules st }---- |--- Updates the state to have more loaded files.----updateModules :: [(Either P.RebuildPolicy FilePath, P.Module)] -> PSCiState -> PSCiState-updateModules modules st = st { psciLoadedModules = psciLoadedModules st ++ modules }---- |--- Updates the state to have more let bindings.----updateLets :: [P.Declaration] -> PSCiState -> PSCiState-updateLets ds st = st { psciLetBindings = psciLetBindings st ++ ds }---- File helpers--- |--- Load the necessary modules.----defaultImports :: [C.ImportedModule]-defaultImports = [(P.ModuleName [P.ProperName "Prelude"], D.Implicit, Nothing)]---- |--- Locates the node executable.--- Checks for either @nodejs@ or @node@.----findNodeProcess :: IO (Maybe String)-findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names-  where names = ["nodejs", "node"]---- |--- Grabs the filename where the history is stored.----getHistoryFilename :: IO FilePath-getHistoryFilename = do-  home <- getHomeDirectory-  let filename = home </> ".purescript" </> "psci_history"-  mkdirp filename-  return filename---- |--- Loads a file for use with imports.----loadModule :: FilePath -> IO (Either String [P.Module])-loadModule filename = do-  content <- readFile filename-  return $ either (Left . show) (Right . map snd) $ P.parseModulesFromFiles id [(filename, content)]---- |--- Load all modules, including the Prelude----loadAllModules :: [FilePath] -> IO (Either Par.ParseError [(Either P.RebuildPolicy FilePath, P.Module)])-loadAllModules files = do-  filesAndContent <- forM files $ \filename -> do-    content <- readFile filename-    return (Right filename, content)-  return $ P.parseModulesFromFiles (either (const "") id) $ (Left P.RebuildNever, P.prelude) : filesAndContent---- |--- Load all modules, updating the application state----loadAllImportedModules :: PSCI ()-loadAllImportedModules = do-  files <- PSCI . lift $ fmap psciImportedFilenames get-  modulesOrFirstError <- psciIO $ loadAllModules files-  case modulesOrFirstError of-    Left err -> psciIO $ print err-    Right modules -> PSCI . lift . modify $ \st -> st { psciLoadedModules = modules }---- |--- Expands tilde in path.----expandTilde :: FilePath -> IO FilePath-expandTilde ('~':p:rest) | isPathSeparator p = (</> rest) <$> getHomeDirectory-expandTilde p = return p--- Messages---- |--- The help message.----helpMessage :: String-helpMessage = "The following commands are available:\n\n    " ++-  intercalate "\n    " (map line D.help)-  where-    line :: (D.Directive, String, String) -> String-    line (dir, arg, desc) = intercalate " "-          [ cmd-          , replicate (11 - length cmd) ' '-          , arg-          , replicate (11 - length arg) ' '-          , desc-          ]-      where cmd = ":" ++ head (D.commands dir)---- |--- The welcome prologue.----prologueMessage :: String-prologueMessage = intercalate "\n"-  [ " ____                 ____            _       _   "-  , "|  _ \\ _   _ _ __ ___/ ___|  ___ _ __(_)_ __ | |_ "-  , "| |_) | | | | '__/ _ \\___ \\ / __| '__| | '_ \\| __|"-  , "|  __/| |_| | | |  __/___) | (__| |  | | |_) | |_ "-  , "|_|    \\__,_|_|  \\___|____/ \\___|_|  |_| .__/ \\__|"-  , "                                       |_|        "-  , ""-  , ":? shows help"-  ]---- |--- The quit message.----quitMessage :: String-quitMessage = "See ya!"---- Haskeline completions--data CompletionContext = Command String | FilePath String | Module | Identifier-                       | Type | Fixed [String] | Multiple [CompletionContext]-                         deriving (Show)---- |--- Decide what kind of completion we need based on input.-completionContext :: String -> String -> Maybe CompletionContext-completionContext cmd@"" _ = Just $ Multiple [Command cmd, Identifier]-completionContext (':' : cmd) word =-  case D.parseDirective dstr of-    Just directive | dstr `elem` D.commands directive -> context directive-    _ -> Just $ Command cmd-  where-  dstr :: String-  dstr = takeWhile (not . isSpace) cmd--  context :: D.Directive -> Maybe CompletionContext-  context D.Browse = Just Module-  context D.Load = Just $ FilePath word-  context D.Quit = Nothing-  context D.Reset = Nothing-  context D.Help = Nothing-  context D.Show = Just $ Fixed ["import", "loaded"]-  context D.Type = Just Identifier-  context D.Kind = Just Type-completionContext _ _ = Just Identifier---- |--- Loads module, function, and file completions.----completion :: CompletionFunc (StateT PSCiState IO)-completion = completeWordWithPrev Nothing " \t\n\r" findCompletions-  where-  findCompletions :: String -> String -> StateT PSCiState IO [Completion]-  findCompletions prev word = do-    let ctx = completionContext ((dropWhile isSpace (reverse prev)) ++ word) word-    completions <- case ctx of-      Nothing -> return []-      (Just c) -> (mapMaybe $ either (\cand -> if word `isPrefixOf` cand-                                               then Just $ simpleCompletion cand-                                               else Nothing) Just)-                  <$> getCompletion c-    return $ sortBy sorter completions--  getCompletion :: CompletionContext -> StateT PSCiState IO [Either String Completion]-  getCompletion (FilePath f) = (map Right) <$> listFiles f-  getCompletion Module = (map Left) <$> getModuleNames-  getCompletion Identifier = (map Left) <$> ((++) <$> getIdentNames <*> getDctorNames)-  getCompletion Type = (map Left) <$> getTypeNames-  getCompletion (Fixed list) = return $ (map Left) list-  getCompletion (Multiple contexts) = concat <$> mapM getCompletion contexts-  getCompletion (Command cmd) = return . map (Left . (":" ++)) . nub $ matching-    where-    matching :: [String]-    matching = filter (isPrefixOf cmd) . concatMap (D.commands) $ D.directives--  getLoadedModules :: StateT PSCiState IO [P.Module]-  getLoadedModules = map snd . psciLoadedModules <$> get--  getModuleNames :: StateT PSCiState IO [String]-  getModuleNames = moduleNames <$> getLoadedModules--  mapLoadedModulesAndQualify :: (Show a) => (P.Module -> [a]) -> StateT PSCiState IO [String]-  mapLoadedModulesAndQualify f = do-    ms <- getLoadedModules-    q <- sequence [qualifyIfNeeded m (f m) | m <- ms]-    return $ concat q--  getIdentNames :: StateT PSCiState IO [String]-  getIdentNames = mapLoadedModulesAndQualify identNames--  getDctorNames :: StateT PSCiState IO [String]-  getDctorNames = mapLoadedModulesAndQualify dctorNames--  getTypeNames :: StateT PSCiState IO [String]-  getTypeNames = mapLoadedModulesAndQualify typeDecls--  qualifyIfNeeded :: (Show a) => P.Module -> [a] -> StateT PSCiState IO [String]-  qualifyIfNeeded m decls = do-    let name = P.getModuleName m-    imported <- psciImportedModuleNames <$> get-    let qualified = map (P.Qualified $ Just name) decls-    if name `elem` imported then-        return $ map show $ qualified ++ (map (P.Qualified Nothing) decls)-    else-        return $ map show qualified--  typeDecls :: P.Module -> [N.ProperName]-  typeDecls m = mapMaybe getTypeName $ filter P.isDataDecl (P.exportedDeclarations m)-      where getTypeName :: P.Declaration -> Maybe N.ProperName-            getTypeName (P.TypeSynonymDeclaration name _ _) = Just name-            getTypeName (P.DataDeclaration _ name _ _) = Just name-            getTypeName (P.PositionedDeclaration _ _ d) = getTypeName d-            getTypeName _ = Nothing--  identNames :: P.Module -> [N.Ident]-  identNames (P.Module _ _ ds exports) = nub [ ident | ident <- mapMaybe (getDeclName exports) (D.flattenDecls ds) ]-    where getDeclName :: Maybe [P.DeclarationRef] -> P.Declaration -> Maybe P.Ident-          getDeclName exts decl@(P.ValueDeclaration ident _ _ _)  | P.isExported exts decl = Just ident-          getDeclName exts decl@(P.ExternDeclaration _ ident _ _) | P.isExported exts decl = Just ident-          getDeclName exts (P.PositionedDeclaration _ _ d) = getDeclName exts d-          getDeclName _ _ = Nothing--  dctorNames :: P.Module -> [N.ProperName]-  dctorNames m = nub $ concat $ map (P.exportedDctors m) dnames-    where getDataDeclName :: P.Declaration -> Maybe N.ProperName-          getDataDeclName (P.DataDeclaration _ name _ _) = Just name-          getDataDeclName (P.PositionedDeclaration _ _ d) = getDataDeclName d-          getDataDeclName _ = Nothing--          dnames :: [N.ProperName]-          dnames = (mapMaybe getDataDeclName onlyDataDecls)--          onlyDataDecls :: [P.Declaration]-          onlyDataDecls = (filter P.isDataDecl (P.exportedDeclarations m))--  moduleNames :: [P.Module] -> [String]-  moduleNames ms = nub [show moduleName | P.Module _ moduleName _ _ <- ms]--  sorter :: Completion -> Completion -> Ordering-  sorter (Completion _ d1 _) (Completion _ d2 _) = if ":" `isPrefixOf` d1 then LT else compare d1 d2---- Compilation---- | Compilation options.----options :: P.Options P.Make-options = P.Options False False False Nothing False False False P.MakeOptions---- |--- PSCI monad----newtype PSCI a = PSCI { runPSCI :: InputT (StateT PSCiState IO) a } deriving (Functor, Applicative, Monad)--psciIO :: IO a -> PSCI a-psciIO io = PSCI . lift $ lift io--newtype Make a = Make { unMake :: ReaderT (P.Options P.Make) (ExceptT String IO) a }-  deriving (Functor, Applicative, Monad, MonadError String, MonadReader (P.Options P.Make))--runMake :: Make a -> IO (Either String a)-runMake = runExceptT . flip runReaderT options . unMake--makeIO :: IO a -> Make a-makeIO = Make . lift . ExceptT . fmap (either (Left . show) Right) . tryIOError--instance P.MonadMake Make where-  getTimestamp path = makeIO $ do-    exists <- doesFileExist path-    traverse (const $ getModificationTime path) $ guard exists-  readTextFile path = makeIO $ readFile path-  writeTextFile path text = makeIO $ do-    mkdirp path-    writeFile path text-  progress s = unless (s == "Compiling $PSCI") $ makeIO . putStrLn $ s--mkdirp :: FilePath -> IO ()-mkdirp = createDirectoryIfMissing True . takeDirectory---- |--- Makes a volatile module to execute the current expression.----createTemporaryModule :: Bool -> PSCiState -> P.Expr -> P.Module-createTemporaryModule exec PSCiState{psciImportedModules = imports, psciLetBindings = lets} val =-  let-    moduleName = P.ModuleName [P.ProperName "$PSCI"]-    traceModule = P.ModuleName [P.ProperName "Debug", P.ProperName "Trace"]-    trace = P.Var (P.Qualified (Just traceModule) (P.Ident "print"))-    mainValue = P.App trace (P.Var (P.Qualified Nothing (P.Ident "it")))-    itDecl = P.ValueDeclaration (P.Ident "it") P.Value [] $ Right val-    mainDecl = P.ValueDeclaration (P.Ident "main") P.Value [] $ Right mainValue-    decls = if exec then [itDecl, mainDecl] else [itDecl]-  in-    P.Module [] moduleName ((importDecl `map` imports) ++ lets ++ decls) Nothing----- |--- Makes a volatile module to hold a non-qualified type synonym for a fully-qualified data type declaration.----createTemporaryModuleForKind :: PSCiState -> P.Type -> P.Module-createTemporaryModuleForKind PSCiState{psciImportedModules = imports} typ =-  let-    moduleName = P.ModuleName [P.ProperName "$PSCI"]-    itDecl = P.TypeSynonymDeclaration (P.ProperName "IT") [] typ-  in-    P.Module [] moduleName ((importDecl `map` imports) ++ [itDecl]) Nothing---- |--- Makes a volatile module to execute the current imports.----createTemporaryModuleForImports :: PSCiState -> P.Module-createTemporaryModuleForImports PSCiState{psciImportedModules = imports} =-  let-    moduleName = P.ModuleName [P.ProperName "$PSCI"]-  in-    P.Module [] moduleName (importDecl `map` imports) Nothing--importDecl :: C.ImportedModule -> P.Declaration-importDecl (mn, declType, asQ) = P.ImportDeclaration mn declType asQ--modulesDir :: FilePath-modulesDir = ".psci_modules" ++ pathSeparator : "node_modules"--indexFile :: FilePath-indexFile = ".psci_modules" ++ pathSeparator : "index.js"---- |--- Takes a value declaration and evaluates it with the current state.----handleDeclaration :: P.Expr -> PSCI ()-handleDeclaration val = do-  st <- PSCI $ lift get-  let m = createTemporaryModule True st val-  let nodeArgs = psciNodeFlags st ++ [indexFile]-  e <- psciIO . runMake $ P.make modulesDir (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []-  case e of-    Left err -> PSCI $ outputStrLn err-    Right _ -> do-      psciIO $ writeFile indexFile "require('$PSCI').main();"-      process <- psciIO findNodeProcess-      result  <- psciIO $ traverse (\node -> readProcessWithExitCode node nodeArgs "") process-      case result of-        Just (ExitSuccess,   out, _)   -> PSCI $ outputStrLn out-        Just (ExitFailure _, _,   err) -> PSCI $ outputStrLn err-        Nothing                        -> PSCI $ outputStrLn "Couldn't find node.js"---- |--- Takes a list of declarations and updates the environment, then run a make. If the declaration fails,--- restore the original environment.----handleDecls :: [P.Declaration] -> PSCI ()-handleDecls ds = do-  st <- PSCI $ lift get-  let st' = updateLets ds st-  let m = createTemporaryModule False st' (P.ObjectLiteral [])-  e <- psciIO . runMake $ P.make modulesDir (psciLoadedModules st' ++ [(Left P.RebuildAlways, m)]) []-  case e of-    Left err -> PSCI $ outputStrLn err-    Right _ -> PSCI $ lift (put st')---- |--- Show actual loaded modules in psci.----handleShowLoadedModules :: PSCI ()-handleShowLoadedModules = do-  PSCiState { psciLoadedModules = loadedModules } <- PSCI $ lift get-  psciIO $ readModules loadedModules >>= putStrLn-  return ()-  where readModules = return . unlines . sort . nub . map toModuleName-        toModuleName =  N.runModuleName . (\ (D.Module _ mdName _ _) -> mdName) . snd---- |--- Show the imported modules in psci.----handleShowImportedModules :: PSCI ()-handleShowImportedModules = do-  PSCiState { psciImportedModules = importedModules } <- PSCI $ lift get-  psciIO $ showModules importedModules >>= putStrLn-  return ()-  where-  showModules = return . unlines . sort . map showModule-  showModule (mn, declType, asQ) =-    "import " ++ case asQ of-      Just mn' -> "qualified " ++ N.runModuleName mn ++ " as " ++ N.runModuleName mn'-      Nothing  -> N.runModuleName mn ++ " " ++ showDeclType declType--  showDeclType D.Implicit = ""-  showDeclType (D.Explicit refs) = refsList refs-  showDeclType (D.Hiding refs) = "hiding " ++ refsList refs-  refsList refs = "(" ++ commaList (map showRef refs) ++ ")"--  showRef :: P.DeclarationRef -> String-  showRef (D.TypeRef pn dctors) = show pn ++ "(" ++ maybe ".." (commaList . map N.runProperName) dctors ++ ")"-  showRef (D.ValueRef ident) = show ident-  showRef (D.TypeClassRef pn) = show pn-  showRef (D.TypeInstanceRef ident) = show ident-  showRef (D.PositionedDeclarationRef _ _ ref) = showRef ref--  commaList :: [String] -> String-  commaList = intercalate ", "---- |--- Imports a module, preserving the initial state on failure.----handleImport :: C.ImportedModule -> PSCI ()-handleImport im = do-   st <- updateImportedModules im <$> PSCI (lift get)-   let m = createTemporaryModuleForImports st-   e <- psciIO . runMake $ P.make modulesDir (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []-   case e of-     Left err -> PSCI $ outputStrLn err-     Right _  -> do-       PSCI $ lift $ put st-       return ()---- |--- Takes a value and prints its type----handleTypeOf :: P.Expr -> PSCI ()-handleTypeOf val = do-  st <- PSCI $ lift get-  let m = createTemporaryModule False st val-  e <- psciIO . runMake $ P.make modulesDir (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []-  case e of-    Left err -> PSCI $ outputStrLn err-    Right env' ->-      case M.lookup (P.ModuleName [P.ProperName "$PSCI"], P.Ident "it") (P.names env') of-        Just (ty, _, _) -> PSCI . outputStrLn . P.prettyPrintType $ ty-        Nothing -> PSCI $ outputStrLn "Could not find type"---- |--- Pretty print a module's signatures----printModuleSignatures :: P.ModuleName -> P.Environment -> PSCI ()-printModuleSignatures moduleName env =-  PSCI $ let namesEnv = P.names env-             moduleNamesIdent = (filter ((== moduleName) . fst) . M.keys) namesEnv-             in case moduleNamesIdent of-                  [] -> outputStrLn $ "This module '"++ P.runModuleName moduleName ++"' does not export functions."-                  _ -> ( outputStrLn-                       . unlines-                       . sort-                       . map (showType . findType namesEnv)) moduleNamesIdent-  where findType :: M.Map (P.ModuleName, P.Ident) (P.Type, P.NameKind, P.NameVisibility) -> (P.ModuleName, P.Ident) -> (P.Ident, Maybe (P.Type, P.NameKind, P.NameVisibility))-        findType envNames m@(_, mIdent) = (mIdent, M.lookup m envNames)-        showType :: (P.Ident, Maybe (P.Type, P.NameKind, P.NameVisibility)) -> String-        showType (mIdent, Just (mType, _, _)) = show mIdent ++ " :: " ++ P.prettyPrintType mType-        showType _ = error "The impossible happened in printModuleSignatures."---- |--- Browse a module and displays its signature (if module exists).----handleBrowse :: P.ModuleName -> PSCI ()-handleBrowse moduleName = do-  st <- PSCI $ lift get-  let loadedModules = psciLoadedModules st-  env <- psciIO . runMake $ P.make modulesDir loadedModules []-  case env of-    Left err -> PSCI $ outputStrLn err-    Right env' ->-      if moduleName `notElem` (nub . map ((\ (P.Module _ modName _ _ ) -> modName) . snd)) loadedModules-        then PSCI $ outputStrLn $ "Module '" ++ N.runModuleName moduleName ++ "' is not valid."-        else printModuleSignatures moduleName env'---- |--- Takes a value and prints its kind----handleKindOf :: P.Type -> PSCI ()-handleKindOf typ = do-  st <- PSCI $ lift get-  let m = createTemporaryModuleForKind st typ-      mName = P.ModuleName [P.ProperName "$PSCI"]-  e <- psciIO . runMake $ P.make modulesDir (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []-  case e of-    Left err -> PSCI $ outputStrLn err-    Right env' ->-      case M.lookup (P.Qualified (Just mName) $ P.ProperName "IT") (P.typeSynonyms env') of-        Just (_, typ') -> do-          let chk = P.CheckState env' 0 0 (Just mName)-              k   = L.runStateT (P.unCheck (P.kindOf mName typ')) chk-          case k of-            Left errStack   -> PSCI . outputStrLn . P.prettyPrintMultipleErrors False $ errStack-            Right (kind, _) -> PSCI . outputStrLn . P.prettyPrintKind $ kind-        Nothing -> PSCI $ outputStrLn "Could not find kind"---- Commands---- |--- Parses the input and returns either a Metacommand or an expression.----getCommand :: Bool -> InputT (StateT PSCiState IO) (Either String (Maybe C.Command))-getCommand singleLineMode = do-  firstLine <- getInputLine "> "-  case firstLine of-    Nothing -> return (Right Nothing)-    Just "" -> return (Right Nothing)-    Just s | singleLineMode || head s == ':' -> return . either Left (Right . Just) $ parseCommand s-    Just s -> either Left (Right . Just) . parseCommand <$> go [s]-  where-    go :: [String] -> InputT (StateT PSCiState IO) String-    go ls = maybe (return . unlines $ reverse ls) (go . (:ls)) =<< getInputLine "  "---- |--- Performs an action for each meta-command given, and also for expressions..----handleCommand :: C.Command -> PSCI ()-handleCommand (C.Expression val) = handleDeclaration val-handleCommand C.Help = PSCI $ outputStrLn helpMessage-handleCommand (C.Import im) = handleImport im-handleCommand (C.Decls l) = handleDecls l-handleCommand (C.LoadFile filePath) = do-  absPath <- psciIO $ expandTilde filePath-  exists <- psciIO $ doesFileExist absPath-  if exists then do-    PSCI . lift $ modify (updateImportedFiles absPath)-    m <- psciIO $ loadModule absPath-    case m of-      Left err -> PSCI $ outputStrLn err-      Right mods -> PSCI . lift $ modify (updateModules (map ((,) (Right absPath)) mods))-  else-    PSCI . outputStrLn $ "Couldn't locate: " ++ filePath-handleCommand C.Reset = do-  files <- psciImportedFilenames <$> PSCI (lift get)-  PSCI . lift . modify $ \st -> st-    { psciImportedFilenames   = files-    , psciImportedModules     = defaultImports-    , psciLetBindings         = []-    }-  loadAllImportedModules-handleCommand (C.TypeOf val) = handleTypeOf val-handleCommand (C.KindOf typ) = handleKindOf typ-handleCommand (C.Browse moduleName) = handleBrowse moduleName-handleCommand (C.Show "loaded") = handleShowLoadedModules-handleCommand (C.Show "import") = handleShowImportedModules-handleCommand _ = PSCI $ outputStrLn "Unknown command"--loadUserConfig :: IO (Maybe [C.Command])-loadUserConfig = do-  configFile <- (</> ".psci") <$> getCurrentDirectory-  exists <- doesFileExist configFile-  if exists-  then do-    ls <- lines <$> readFile configFile-    case mapM parseCommand ls of-      Left err -> print err >> exitFailure-      Right cs -> return $ Just cs-  else-    return Nothing---- |--- The PSCI main loop.----loop :: PSCiOptions -> IO ()-loop PSCiOptions{..} = do-  config <- loadUserConfig-  modulesOrFirstError <- loadAllModules psciInputFile-  case modulesOrFirstError of-    Left err -> print err >> exitFailure-    Right modules -> do-      historyFilename <- getHistoryFilename-      let settings = defaultSettings { historyFile = Just historyFilename }-      flip evalStateT (PSCiState psciInputFile defaultImports modules [] psciInputNodeFlags) . runInputT (setComplete completion settings) $ do-        outputStrLn prologueMessage-        traverse_ (mapM_ (runPSCI . handleCommand)) config-        go-      where-        go :: InputT (StateT PSCiState IO) ()-        go = do-          c <- getCommand (not psciMultiLineMode)-          case c of-            Left err -> outputStrLn err >> go-            Right Nothing -> go-            Right (Just C.Quit) -> outputStrLn quitMessage-            Right (Just c') -> runPSCI (loadAllImportedModules >> handleCommand c') >> go--multiLineMode :: Parser Bool-multiLineMode = switch $-     long "multi-line-mode"-  <> short 'm'-  <> Opts.help "Run in multi-line mode (use ^D to terminate commands)"--inputFile :: Parser FilePath-inputFile = strArgument $-     metavar "FILE"-  <> Opts.help "Optional .purs files to load on start"--nodeFlagsFlag :: Parser [String]-nodeFlagsFlag = option parser $-     long "node-opts"-  <> metavar "NODE_OPTS"-  <> value []-  <> Opts.help "Flags to pass to node, separated by spaces"-  where-    parser = words <$> str--psciOptions :: Parser PSCiOptions-psciOptions = PSCiOptions <$> multiLineMode-                          <*> many inputFile-                          <*> nodeFlagsFlag--main :: IO ()-main = execParser opts >>= loop-  where-  opts        = info (version <*> helper <*> psciOptions) infoModList-  infoModList = fullDesc <> headerInfo <> footerInfo-  headerInfo  = header   "psci - Interactive mode for PureScript"-  footerInfo  = footer $ "psci " ++ showVersion Paths.version--  version :: Parser (a -> a)-  version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> Opts.help "Show the version number" <> hidden

+ psci/Make.hs view

@@ -0,0 +1,127 @@+-----------------------------------------------------------------------------+--+-- Module      :  Make+-- Copyright   :  (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors+-- License     :  MIT+--+-- Maintainer  :  Phil Freeman <paf31@cantab.net>+-- Stability   :  experimental+-- Portability :+--+-- |+--+-----------------------------------------------------------------------------++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TupleSections #-}++module Make where++import Data.List (isPrefixOf)+import Data.Maybe (fromMaybe)+import Data.Time.Clock+import Data.Traversable (traverse)+import qualified Data.Map as M++import Control.Applicative+import Control.Monad+import Control.Monad.Error.Class (MonadError(..))+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Reader (MonadReader, ReaderT, runReaderT)+import Control.Monad.Trans.Except (ExceptT(..), runExceptT)+import Control.Monad.Writer (MonadWriter, WriterT, runWriterT, tell)++import System.Directory (getModificationTime, doesFileExist)+import System.FilePath ((</>), pathSeparator)+import System.IO.Error (tryIOError)++import qualified Language.PureScript as P+import qualified Language.PureScript.CodeGen.JS as J+import qualified Language.PureScript.CoreFn as CF++import IO (mkdirp)++options :: P.Options+options = P.Options False False Nothing False False False Nothing++modulesDir :: FilePath+modulesDir = ".psci_modules" ++ pathSeparator : "node_modules"++newtype Make a = Make { unMake :: ReaderT P.Options (WriterT P.MultipleErrors (ExceptT P.MultipleErrors IO)) a }+  deriving (Functor, Applicative, Monad, MonadIO, MonadError P.MultipleErrors, MonadWriter P.MultipleErrors, MonadReader P.Options)++runMake :: Make a -> IO (Either P.MultipleErrors a)+runMake = runExceptT . fmap fst . runWriterT . flip runReaderT options . unMake++makeIO :: (IOError -> P.ErrorMessage) -> IO a -> Make a+makeIO f io = do+  e <- liftIO $ tryIOError io+  either (throwError . P.singleError . f) return e++-- Traverse (Either e) instance (base 4.7)+traverseEither :: Applicative f => (a -> f b) -> Either e a -> f (Either e b)+traverseEither _ (Left x) = pure (Left x)+traverseEither f (Right y) = Right <$> f y++buildMakeActions :: M.Map P.ModuleName (Either P.RebuildPolicy String)+                 -> M.Map P.ModuleName P.ForeignJS+                 -> P.MakeActions Make+buildMakeActions filePathMap foreigns =+  P.MakeActions getInputTimestamp getOutputTimestamp readExterns codegen progress+  where++  getInputTimestamp :: P.ModuleName -> Make (Either P.RebuildPolicy (Maybe UTCTime))+  getInputTimestamp mn = do+    let path = fromMaybe (error "Module has no filename in 'make'") $ M.lookup mn filePathMap+    traverseEither getTimestamp path++  getOutputTimestamp :: P.ModuleName -> Make (Maybe UTCTime)+  getOutputTimestamp mn = do+    let filePath = P.runModuleName mn+        jsFile = modulesDir </> filePath </> "index.js"+        externsFile = modulesDir </> filePath </> "externs.purs"+    min <$> getTimestamp jsFile <*> getTimestamp externsFile++  readExterns :: P.ModuleName -> Make (FilePath, String)+  readExterns mn = do+    let path = modulesDir </> P.runModuleName mn </> "externs.purs"+    (path, ) <$> readTextFile path++  codegen :: CF.Module CF.Ann -> P.Environment -> P.SupplyVar -> P.Externs -> Make ()+  codegen m _ nextVar exts = do+    let mn = CF.moduleName m+    foreignInclude <- case CF.moduleName m `M.lookup` foreigns of+      Just path+        | not $ requiresForeign m -> do tell $ P.errorMessage $ P.UnnecessaryFFIModule mn path+                                        return Nothing+        | otherwise -> return $ Just $ J.JSApp (J.JSVar "require") [J.JSStringLiteral "./foreign"]+      Nothing | requiresForeign m -> throwError . P.errorMessage $ P.MissingFFIModule mn+              | otherwise -> return Nothing+    pjs <- P.evalSupplyT nextVar $ P.prettyPrintJS <$> J.moduleToJs m foreignInclude+    let filePath = P.runModuleName $ CF.moduleName m+        jsFile = modulesDir </> filePath </> "index.js"+        externsFile = modulesDir </> filePath </> "externs.purs"+        foreignFile = modulesDir </> filePath </> "foreign.js"+    writeTextFile jsFile pjs+    maybe (return ()) (writeTextFile foreignFile) $ CF.moduleName m `M.lookup` foreigns+    writeTextFile externsFile exts++  requiresForeign :: CF.Module a -> Bool+  requiresForeign = not . null . CF.moduleForeign++  getTimestamp :: FilePath -> Make (Maybe UTCTime)+  getTimestamp path = makeIO (const (P.SimpleErrorWrapper $ P.CannotGetFileInfo path)) $ do+    exists <- doesFileExist path+    traverse (const $ getModificationTime path) $ guard exists++  readTextFile :: FilePath -> Make String+  readTextFile path = makeIO (const (P.SimpleErrorWrapper $ P.CannotReadFile path)) $ readFile path++  writeTextFile :: FilePath -> String -> Make ()+  writeTextFile path text = makeIO (const (P.SimpleErrorWrapper $ P.CannotWriteFile path)) $ do+    mkdirp path+    writeFile path text++  progress :: String -> Make ()+  progress s = unless ("Compiling $PSCI" `isPrefixOf` s) $ liftIO . putStrLn $ s

+ psci/PSCi.hs view

@@ -0,0 +1,569 @@+-----------------------------------------------------------------------------+--+-- Module      :  PSCi+-- Copyright   :  (c) Phil Freeman 2013+-- License     :  MIT+--+-- Maintainer  :  Phil Freeman <paf31@cantab.net>+-- Stability   :  experimental+-- Portability :+--+-- |+-- PureScript Compiler Interactive.+--+-----------------------------------------------------------------------------++{-# LANGUAGE DoAndIfThenElse #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-}++module PSCi where++import Data.Foldable (traverse_)+import Data.List (intercalate, nub, sort)+import Data.Traversable (traverse)+import Data.Tuple (swap)+import Data.Version (showVersion)+import qualified Data.Map as M++import Control.Applicative+import Control.Arrow (first)+import Control.Monad+import Control.Monad.Trans.Class+import Control.Monad.Trans.Except (runExceptT)+import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)+import Control.Monad.Trans.State.Strict+import Control.Monad.Writer (runWriter)+import qualified Control.Monad.Trans.State.Lazy as L++import Options.Applicative as Opts++import System.Console.Haskeline+import System.Directory (doesFileExist, findExecutable, getHomeDirectory, getCurrentDirectory)+import System.Exit+import System.FilePath (pathSeparator, (</>), isPathSeparator)+import System.FilePath.Glob (glob)+import System.Process (readProcessWithExitCode)++import qualified Language.PureScript as P+import qualified Language.PureScript.Names as N+import qualified Paths_purescript as Paths++import qualified Directive as D+import Completion (completion)+import IO (mkdirp)+import Make+import Parser (parseCommand)+import Types++-- | The name of the PSCI support module+supportModuleName :: P.ModuleName+supportModuleName = P.ModuleName [P.ProperName "$PSCI", P.ProperName "Support"]++-- | Support module, contains code to evaluate terms+supportModule :: P.Module+supportModule =+  case P.parseModulesFromFiles id [("", code)] of+    Right [(_, P.Module cs _ ds exps)] -> P.Module cs supportModuleName ds exps+    _ -> error "Support module could not be parsed"+  where+  code :: String+  code = unlines+    [ "module S where"+    , ""+    , "import Prelude"+    , "import Control.Monad.Eff"+    , "import Control.Monad.Eff.Console"+    , "import Control.Monad.Eff.Unsafe"+    , ""+    , "class Eval a where"+    , "  eval :: a -> Eff (console :: CONSOLE) Unit"+    , ""+    , "instance evalShow :: (Show a) => Eval a where"+    , "  eval = print"+    , ""+    , "instance evalEff :: (Eval a) => Eval (Eff eff a) where"+    , "  eval x = unsafeInterleaveEff x >>= eval"+    ]++-- File helpers++-- |+-- Locates the node executable.+-- Checks for either @nodejs@ or @node@.+--+findNodeProcess :: IO (Maybe String)+findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names+  where names = ["nodejs", "node"]++-- |+-- Grabs the filename where the history is stored.+--+getHistoryFilename :: IO FilePath+getHistoryFilename = do+  home <- getHomeDirectory+  let filename = home </> ".purescript" </> "psci_history"+  mkdirp filename+  return filename++-- |+-- Loads a file for use with imports.+--+loadModule :: FilePath -> IO (Either String [P.Module])+loadModule filename = do+  content <- readFile filename+  return $ either (Left . P.prettyPrintMultipleErrors False) (Right . map snd) $ P.parseModulesFromFiles id [(filename, content)]++-- |+-- Load all modules.+--+loadAllModules :: [FilePath] -> IO (Either P.MultipleErrors [(Either P.RebuildPolicy FilePath, P.Module)])+loadAllModules files = do+  filesAndContent <- forM files $ \filename -> do+    content <- readFile filename+    return (Right filename, content)+  return $ P.parseModulesFromFiles (either (const "") id) filesAndContent++-- |+-- Load all modules, updating the application state+--+loadAllImportedModules :: PSCI ()+loadAllImportedModules = do+  files <- PSCI . lift $ fmap psciImportedFilenames get+  modulesOrFirstError <- psciIO $ loadAllModules files+  case modulesOrFirstError of+    Left errs -> printErrors errs+    Right modules -> PSCI . lift . modify $ \st -> st { psciLoadedModules = modules }++-- |+-- Expands tilde in path.+--+expandTilde :: FilePath -> IO FilePath+expandTilde ('~':p:rest) | isPathSeparator p = (</> rest) <$> getHomeDirectory+expandTilde p = return p++-- Messages++-- |+-- The help message.+--+helpMessage :: String+helpMessage = "The following commands are available:\n\n    " +++  intercalate "\n    " (map line D.help) +++  "\n\n" ++ extraHelp+  where+  line :: (Directive, String, String) -> String+  line (dir, arg, desc) =+    let cmd = ':' : D.stringFor dir+    in unwords [ cmd+               , replicate (11 - length cmd) ' '+               , arg+               , replicate (11 - length arg) ' '+               , desc+               ]++  extraHelp =+    "Further information is available on the PureScript wiki:\n" +++    " --> https://github.com/purescript/purescript/wiki/psci"+++-- |+-- The welcome prologue.+--+prologueMessage :: String+prologueMessage = intercalate "\n"+  [ " ____                 ____            _       _   "+  , "|  _ \\ _   _ _ __ ___/ ___|  ___ _ __(_)_ __ | |_ "+  , "| |_) | | | | '__/ _ \\___ \\ / __| '__| | '_ \\| __|"+  , "|  __/| |_| | | |  __/___) | (__| |  | | |_) | |_ "+  , "|_|    \\__,_|_|  \\___|____/ \\___|_|  |_| .__/ \\__|"+  , "                                       |_|        "+  , ""+  , ":? shows help"+  ]++-- |+-- The quit message.+--+quitMessage :: String+quitMessage = "See ya!"++-- |+-- PSCI monad+--+newtype PSCI a = PSCI { runPSCI :: InputT (StateT PSCiState IO) a } deriving (Functor, Applicative, Monad)++psciIO :: IO a -> PSCI a+psciIO io = PSCI . lift $ lift io++-- |+-- Makes a volatile module to execute the current expression.+--+createTemporaryModule :: Bool -> PSCiState -> P.Expr -> P.Module+createTemporaryModule exec PSCiState{psciImportedModules = imports, psciLetBindings = lets} val =+  let+    moduleName = P.ModuleName [P.ProperName "$PSCI"]+    trace = P.Var (P.Qualified (Just supportModuleName) (P.Ident "eval"))+    mainValue = P.App trace (P.Var (P.Qualified Nothing (P.Ident "it")))+    itDecl = P.ValueDeclaration (P.Ident "it") P.Public [] $ Right val+    mainDecl = P.ValueDeclaration (P.Ident "main") P.Public [] $ Right mainValue+    decls = if exec then [itDecl, mainDecl] else [itDecl]+  in+    P.Module [] moduleName ((importDecl `map` imports) ++ lets ++ decls) Nothing+++-- |+-- Makes a volatile module to hold a non-qualified type synonym for a fully-qualified data type declaration.+--+createTemporaryModuleForKind :: PSCiState -> P.Type -> P.Module+createTemporaryModuleForKind PSCiState{psciImportedModules = imports} typ =+  let+    moduleName = P.ModuleName [P.ProperName "$PSCI"]+    itDecl = P.TypeSynonymDeclaration (P.ProperName "IT") [] typ+  in+    P.Module [] moduleName ((importDecl `map` imports) ++ [itDecl]) Nothing++-- |+-- Makes a volatile module to execute the current imports.+--+createTemporaryModuleForImports :: PSCiState -> P.Module+createTemporaryModuleForImports PSCiState{psciImportedModules = imports} =+  let+    moduleName = P.ModuleName [P.ProperName "$PSCI"]+  in+    P.Module [] moduleName (importDecl `map` imports) Nothing++importDecl :: ImportedModule -> P.Declaration+importDecl (mn, declType, asQ) = P.ImportDeclaration mn declType asQ++indexFile :: FilePath+indexFile = ".psci_modules" ++ pathSeparator : "index.js"++make :: PSCiState -> [(Either P.RebuildPolicy FilePath, P.Module)] -> Make P.Environment+make PSCiState{..} ms =+  let filePathMap = M.fromList $ (first P.getModuleName . swap) `map` (psciLoadedModules ++ ms)+  in P.make (buildMakeActions filePathMap (M.map snd psciForeignFiles)) (psciLoadedModules ++ ms)++-- |+-- Takes a value declaration and evaluates it with the current state.+--+handleDeclaration :: P.Expr -> PSCI ()+handleDeclaration val = do+  st <- PSCI $ lift get+  let m = createTemporaryModule True st val+  let nodeArgs = psciNodeFlags st ++ [indexFile]+  e <- psciIO . runMake $ make st [(Left P.RebuildAlways, supportModule), (Left P.RebuildAlways, m)]+  case e of+    Left errs -> printErrors errs+    Right _ -> do+      psciIO $ writeFile indexFile "require('$PSCI').main();"+      process <- psciIO findNodeProcess+      result  <- psciIO $ traverse (\node -> readProcessWithExitCode node nodeArgs "") process+      case result of+        Just (ExitSuccess,   out, _)   -> PSCI $ outputStrLn out+        Just (ExitFailure _, _,   err) -> PSCI $ outputStrLn err+        Nothing                        -> PSCI $ outputStrLn "Couldn't find node.js"++-- |+-- Takes a list of declarations and updates the environment, then run a make. If the declaration fails,+-- restore the original environment.+--+handleDecls :: [P.Declaration] -> PSCI ()+handleDecls ds = do+  st <- PSCI $ lift get+  let st' = updateLets ds st+  let m = createTemporaryModule False st' (P.ObjectLiteral [])+  e <- psciIO . runMake $ make st' [(Left P.RebuildAlways, m)]+  case e of+    Left err -> printErrors err+    Right _ -> PSCI $ lift (put st')++-- |+-- Show actual loaded modules in psci.+--+handleShowLoadedModules :: PSCI ()+handleShowLoadedModules = do+  PSCiState { psciLoadedModules = loadedModules } <- PSCI $ lift get+  psciIO $ readModules loadedModules >>= putStrLn+  return ()+  where readModules = return . unlines . sort . nub . map toModuleName+        toModuleName =  N.runModuleName . (\ (P.Module _ mdName _ _) -> mdName) . snd++-- |+-- Show the imported modules in psci.+--+handleShowImportedModules :: PSCI ()+handleShowImportedModules = do+  PSCiState { psciImportedModules = importedModules } <- PSCI $ lift get+  psciIO $ showModules importedModules >>= putStrLn+  return ()+  where+  showModules = return . unlines . sort . map showModule+  showModule (mn, declType, asQ) =+    "import " ++ case asQ of+      Just mn' -> "qualified " ++ N.runModuleName mn ++ " as " ++ N.runModuleName mn'+      Nothing  -> N.runModuleName mn ++ " " ++ showDeclType declType++  showDeclType P.Implicit = ""+  showDeclType (P.Explicit refs) = refsList refs+  showDeclType (P.Hiding refs) = "hiding " ++ refsList refs+  refsList refs = "(" ++ commaList (map showRef refs) ++ ")"++  showRef :: P.DeclarationRef -> String+  showRef (P.TypeRef pn dctors) = show pn ++ "(" ++ maybe ".." (commaList . map N.runProperName) dctors ++ ")"+  showRef (P.ValueRef ident) = show ident+  showRef (P.TypeClassRef pn) = show pn+  showRef (P.TypeInstanceRef ident) = show ident+  showRef (P.ModuleRef name) = "module " ++ show name+  showRef (P.PositionedDeclarationRef _ _ ref) = showRef ref++  commaList :: [String] -> String+  commaList = intercalate ", "++-- |+-- Imports a module, preserving the initial state on failure.+--+handleImport :: ImportedModule -> PSCI ()+handleImport im = do+   st <- updateImportedModules im <$> PSCI (lift get)+   let m = createTemporaryModuleForImports st+   e <- psciIO . runMake $ make st [(Left P.RebuildAlways, m)]+   case e of+     Left errs -> printErrors errs+     Right _  -> do+       PSCI $ lift $ put st+       return ()++-- |+-- Takes a value and prints its type+--+handleTypeOf :: P.Expr -> PSCI ()+handleTypeOf val = do+  st <- PSCI $ lift get+  let m = createTemporaryModule False st val+  e <- psciIO . runMake $ make st [(Left P.RebuildAlways, m)]+  case e of+    Left errs -> printErrors errs+    Right env' ->+      case M.lookup (P.ModuleName [P.ProperName "$PSCI"], P.Ident "it") (P.names env') of+        Just (ty, _, _) -> PSCI . outputStrLn . P.prettyPrintType $ ty+        Nothing -> PSCI $ outputStrLn "Could not find type"++-- |+-- Pretty print a module's signatures+--+printModuleSignatures :: P.ModuleName -> P.Environment -> PSCI ()+printModuleSignatures moduleName env =+  PSCI $ let namesEnv = P.names env+             moduleNamesIdent = (filter ((== moduleName) . fst) . M.keys) namesEnv+             in case moduleNamesIdent of+                  [] -> outputStrLn $ "This module '"++ P.runModuleName moduleName ++"' does not export functions."+                  _ -> ( outputStrLn+                       . unlines+                       . sort+                       . map (showType . findType namesEnv)) moduleNamesIdent+  where findType :: M.Map (P.ModuleName, P.Ident) (P.Type, P.NameKind, P.NameVisibility) -> (P.ModuleName, P.Ident) -> (P.Ident, Maybe (P.Type, P.NameKind, P.NameVisibility))+        findType envNames m@(_, mIdent) = (mIdent, M.lookup m envNames)+        showType :: (P.Ident, Maybe (P.Type, P.NameKind, P.NameVisibility)) -> String+        showType (mIdent, Just (mType, _, _)) = show mIdent ++ " :: " ++ P.prettyPrintType mType+        showType _ = error "The impossible happened in printModuleSignatures."++-- |+-- Browse a module and displays its signature (if module exists).+--+handleBrowse :: P.ModuleName -> PSCI ()+handleBrowse moduleName = do+  st <- PSCI $ lift get+  env <- psciIO . runMake $ make st []+  case env of+    Left errs -> printErrors errs+    Right env' ->+      if moduleName `notElem` (nub . map ((\ (P.Module _ modName _ _ ) -> modName) . snd)) (psciLoadedModules st)+        then PSCI $ outputStrLn $ "Module '" ++ N.runModuleName moduleName ++ "' is not valid."+        else printModuleSignatures moduleName env'++-- | Pretty-print errors+printErrors :: P.MultipleErrors -> PSCI ()+printErrors = PSCI . outputStrLn . P.prettyPrintMultipleErrors False++-- |+-- Takes a value and prints its kind+--+handleKindOf :: P.Type -> PSCI ()+handleKindOf typ = do+  st <- PSCI $ lift get+  let m = createTemporaryModuleForKind st typ+      mName = P.ModuleName [P.ProperName "$PSCI"]+  e <- psciIO . runMake $ make st [(Left P.RebuildAlways, m)]+  case e of+    Left errs -> printErrors errs+    Right env' ->+      case M.lookup (P.Qualified (Just mName) $ P.ProperName "IT") (P.typeSynonyms env') of+        Just (_, typ') -> do+          let chk = P.CheckState env' 0 0 (Just mName)+              k   = fst . runWriter . runExceptT $ L.runStateT (P.unCheck (P.kindOf mName typ')) chk+          case k of+            Left errStack   -> PSCI . outputStrLn . P.prettyPrintMultipleErrors False $ errStack+            Right (kind, _) -> PSCI . outputStrLn . P.prettyPrintKind $ kind+        Nothing -> PSCI $ outputStrLn "Could not find kind"++-- Commands++-- |+-- Parses the input and returns either a Metacommand, or an error as a string.+--+getCommand :: Bool -> InputT (StateT PSCiState IO) (Either String (Maybe Command))+getCommand singleLineMode = do+  firstLine <- getInputLine "> "+  case firstLine of+    Nothing -> return (Right Nothing)+    Just "" -> return (Right Nothing)+    Just s | singleLineMode || head s == ':' -> return . either Left (Right . Just) $ parseCommand s+    Just s -> either Left (Right . Just) . parseCommand <$> go [s]+  where+    go :: [String] -> InputT (StateT PSCiState IO) String+    go ls = maybe (return . unlines $ reverse ls) (go . (:ls)) =<< getInputLine "  "++-- |+-- Performs an action for each meta-command given, and also for expressions.+--+handleCommand :: Command -> PSCI ()+handleCommand (Expression val) = handleDeclaration val+handleCommand ShowHelp = PSCI $ outputStrLn helpMessage+handleCommand (Import im) = handleImport im+handleCommand (Decls l) = handleDecls l+handleCommand (LoadFile filePath) = whenFileExists filePath $ \absPath -> do+  PSCI . lift $ modify (updateImportedFiles absPath)+  m <- psciIO $ loadModule absPath+  case m of+    Left err -> PSCI $ outputStrLn err+    Right mods -> PSCI . lift $ modify (updateModules (map ((,) (Right absPath)) mods))+handleCommand (LoadForeign filePath) = whenFileExists filePath $ \absPath -> do+  foreignsOrError <- psciIO . runMake $ do+    foreignFile <- makeIO (const (P.SimpleErrorWrapper $ P.CannotReadFile absPath)) (readFile absPath)+    P.parseForeignModulesFromFiles [(absPath, foreignFile)]+  case foreignsOrError of+    Left err -> PSCI $ outputStrLn $ P.prettyPrintMultipleErrors False err+    Right foreigns -> PSCI . lift $ modify (updateForeignFiles foreigns)+handleCommand ResetState = do+  files <- psciImportedFilenames <$> PSCI (lift get)+  PSCI . lift . modify $ \st -> st+    { psciImportedFilenames   = files+    , psciImportedModules     = []+    , psciLetBindings         = []+    }+  loadAllImportedModules+handleCommand (TypeOf val) = handleTypeOf val+handleCommand (KindOf typ) = handleKindOf typ+handleCommand (BrowseModule moduleName) = handleBrowse moduleName+handleCommand (ShowInfo QueryLoaded) = handleShowLoadedModules+handleCommand (ShowInfo QueryImport) = handleShowImportedModules+handleCommand QuitPSCi = error "`handleCommand QuitPSCi` was called. This is a bug."++whenFileExists :: FilePath -> (FilePath -> PSCI ()) -> PSCI ()+whenFileExists filePath f = do+  absPath <- psciIO $ expandTilde filePath+  exists <- psciIO $ doesFileExist absPath+  if exists +    then f absPath+    else PSCI . outputStrLn $ "Couldn't locate: " ++ filePath++loadUserConfig :: IO (Maybe [Command])+loadUserConfig = do+  configFile <- (</> ".psci") <$> getCurrentDirectory+  exists <- doesFileExist configFile+  if exists+  then do+    ls <- lines <$> readFile configFile+    case mapM parseCommand ls of+      Left err -> print err >> exitFailure+      Right cs -> return $ Just cs+  else+    return Nothing++-- | Checks if the Console module is defined+consoleIsDefined :: [P.Module] -> Bool+consoleIsDefined = any ((== P.ModuleName (map P.ProperName [ "Control", "Monad", "Eff", "Console" ])) . P.getModuleName)++-- |+-- The PSCI main loop.+--+loop :: PSCiOptions -> IO ()+loop PSCiOptions{..} = do+  config <- loadUserConfig+  inputFiles <- concat <$> mapM glob psciInputFile+  foreignFiles <- concat <$> mapM glob psciForeignInputFiles+  modulesOrFirstError <- loadAllModules inputFiles+  case modulesOrFirstError of+    Left errs -> putStrLn (P.prettyPrintMultipleErrors False errs) >> exitFailure+    Right modules -> do+      historyFilename <- getHistoryFilename+      let settings = defaultSettings { historyFile = Just historyFilename }+      foreignsOrError <- runMake $ do+        foreignFilesContent <- forM foreignFiles (\inFile -> (inFile,) <$> makeIO (const (P.SimpleErrorWrapper $ P.CannotReadFile inFile)) (readFile inFile))+        P.parseForeignModulesFromFiles foreignFilesContent+      case foreignsOrError of+        Left errs -> putStrLn (P.prettyPrintMultipleErrors False errs) >> exitFailure+        Right foreigns ->+          flip evalStateT (PSCiState inputFiles [] modules foreigns [] psciInputNodeFlags) . runInputT (setComplete completion settings) $ do+            outputStrLn prologueMessage+            traverse_ (mapM_ (runPSCI . handleCommand)) config+            modules' <- lift $ gets psciLoadedModules+            unless (consoleIsDefined (map snd modules')) . outputStrLn $ unlines+              [ "PSCi requires the purescript-console module to be installed."+              , "For help getting started, visit http://wiki.purescript.org/PSCi"+              ]+            go+      where+        go :: InputT (StateT PSCiState IO) ()+        go = do+          c <- getCommand (not psciMultiLineMode)+          case c of+            Left err -> outputStrLn err >> go+            Right Nothing -> go+            Right (Just QuitPSCi) -> outputStrLn quitMessage+            Right (Just c') -> runPSCI (loadAllImportedModules >> handleCommand c') >> go++multiLineMode :: Parser Bool+multiLineMode = switch $+     long "multi-line-mode"+  <> short 'm'+  <> Opts.help "Run in multi-line mode (use ^D to terminate commands)"++inputFile :: Parser FilePath+inputFile = strArgument $+     metavar "FILE"+  <> Opts.help "Optional .purs files to load on start"++inputForeignFile :: Parser FilePath+inputForeignFile = strOption $+     short 'f'+  <> long "ffi"+  <> help "The input .js file(s) providing foreign import implementations"++nodeFlagsFlag :: Parser [String]+nodeFlagsFlag = option parser $+     long "node-opts"+  <> metavar "NODE_OPTS"+  <> value []+  <> Opts.help "Flags to pass to node, separated by spaces"+  where+    parser = words <$> str++psciOptions :: Parser PSCiOptions+psciOptions = PSCiOptions <$> multiLineMode+                          <*> many inputFile+                          <*> many inputForeignFile+                          <*> nodeFlagsFlag++runPSCi :: IO ()+runPSCi = execParser opts >>= loop+  where+  opts        = info (version <*> helper <*> psciOptions) infoModList+  infoModList = fullDesc <> headerInfo <> footerInfo+  headerInfo  = header   "psci - Interactive mode for PureScript"+  footerInfo  = footer $ "psci " ++ showVersion Paths.version++  version :: Parser (a -> a)+  version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> Opts.help "Show the version number" <> hidden

psci/Parser.hs view

@@ -19,22 +19,23 @@  import Prelude hiding (lex) -import qualified Commands as C-import qualified Directive as D- import Data.Char (isSpace)+import Data.List (intercalate)  import Control.Applicative hiding (many)  import Text.Parsec hiding ((<|>))  import qualified Language.PureScript as P-import qualified Language.PureScript.Parser.Common as C (mark, same)+import Language.PureScript.Parser.Common (mark, same) +import qualified Directive as D+import Types+ -- | -- Parses PSCI metacommands or expressions input from the user. ---parseCommand :: String -> Either String C.Command+parseCommand :: String -> Either String Command parseCommand cmdString =   case cmdString of     (':' : cmd) -> parseDirective cmd@@ -45,7 +46,7 @@   ts <- P.lex "" s   P.runTokenParser "" (p <* eof) ts -psciCommand :: P.TokenParser C.Command+psciCommand :: P.TokenParser Command psciCommand = choice (map try parsers)   where   parsers =@@ -64,25 +65,32 @@ trimEnd :: String -> String trimEnd = reverse . trimStart . reverse -parseDirective :: String -> Either String C.Command+parseDirective :: String -> Either String Command parseDirective cmd =-  case D.parseDirective dstr of-    Just D.Help -> return C.Help-    Just D.Quit -> return C.Quit-    Just D.Reset -> return C.Reset-    Just D.Browse -> C.Browse <$> parseRest P.moduleName arg-    Just D.Load -> return $ C.LoadFile (trim arg)-    Just D.Show -> return $ C.Show (trim arg)-    Just D.Type -> C.TypeOf <$> parseRest P.parseValue arg-    Just D.Kind -> C.KindOf <$> parseRest P.parseType arg-    Nothing -> Left $ "Unrecognized command. Type :? for help."-  where (dstr, arg) = break isSpace cmd+  case D.directivesFor' dstr of+    [(d, _)] -> commandFor d+    []       -> Left "Unrecognized directive. Type :? for help."+    ds       -> Left ("Ambiguous directive. Possible matches: " +++                  intercalate ", " (map snd ds) ++ ". Type :? for help.")+  where+  (dstr, arg) = break isSpace cmd +  commandFor d = case d of+    Help    -> return ShowHelp+    Quit    -> return QuitPSCi+    Reset   -> return ResetState+    Browse  -> BrowseModule <$> parseRest P.moduleName arg+    Load    -> return $ LoadFile (trim arg)+    Foreign -> return $ LoadForeign (trim arg)+    Show    -> ShowInfo <$> parseReplQuery' (trim arg)+    Type    -> TypeOf <$> parseRest P.parseValue arg+    Kind    -> KindOf <$> parseRest P.parseType arg+ -- | -- Parses expressions entered at the PSCI repl. ---psciExpression :: P.TokenParser C.Command-psciExpression = C.Expression <$> P.parseValue+psciExpression :: P.TokenParser Command+psciExpression = Expression <$> P.parseValue  -- | -- PSCI version of @let@.@@ -90,21 +98,21 @@ -- However, since we don't support the @Eff@ monad, -- we actually want the normal @let@. ---psciLet :: P.TokenParser C.Command-psciLet = C.Decls <$> (P.reserved "let" *> P.indented *> manyDecls)+psciLet :: P.TokenParser Command+psciLet = Decls <$> (P.reserved "let" *> P.indented *> manyDecls)   where   manyDecls :: P.TokenParser [P.Declaration]-  manyDecls = C.mark (many1 (C.same *> P.parseLocalDeclaration))+  manyDecls = mark (many1 (same *> P.parseLocalDeclaration))  -- | Imports must be handled separately from other declarations, so that -- :show import works, for example.-psciImport :: P.TokenParser C.Command-psciImport = C.Import <$> P.parseImportDeclaration'+psciImport :: P.TokenParser Command+psciImport = Import <$> P.parseImportDeclaration'  -- | Any other declaration that we don't need a 'special case' parser for -- (like let or import declarations).-psciOtherDeclaration :: P.TokenParser C.Command-psciOtherDeclaration = C.Decls . (:[]) <$> do+psciOtherDeclaration :: P.TokenParser Command+psciOtherDeclaration = Decls . (:[]) <$> do   decl <- discardPositionInfo <$> P.parseDeclaration   if acceptable decl     then return decl@@ -115,11 +123,18 @@ discardPositionInfo d = d  acceptable :: P.Declaration -> Bool-acceptable (P.DataDeclaration _ _ _ _) = True-acceptable (P.TypeSynonymDeclaration _ _ _) = True-acceptable (P.ExternDeclaration _ _ _ _) = True-acceptable (P.ExternDataDeclaration _ _) = True-acceptable (P.ExternInstanceDeclaration _ _ _ _) = True-acceptable (P.TypeClassDeclaration _ _ _ _) = True-acceptable (P.TypeInstanceDeclaration _ _ _ _ _) = True+acceptable P.DataDeclaration{} = True+acceptable P.TypeSynonymDeclaration{} = True+acceptable P.ExternDeclaration{} = True+acceptable P.ExternDataDeclaration{} = True+acceptable P.ExternInstanceDeclaration{} = True+acceptable P.TypeClassDeclaration{} = True+acceptable P.TypeInstanceDeclaration{} = True acceptable _ = False++parseReplQuery' :: String -> Either String ReplQuery+parseReplQuery' str =+  case parseReplQuery str of+    Nothing -> Left ("Don't know how to show " ++ str ++ ". Try one of: " +++                      intercalate ", " replQueryStrings ++ ".")+    Just query -> Right query

+ psci/Types.hs view

@@ -0,0 +1,181 @@+-----------------------------------------------------------------------------+--+-- Module      :  Types+-- Copyright   :  (c) Phil Freeman 2014+-- License     :  MIT+--+-- Maintainer  :  Phil Freeman <paf31@cantab.net>+-- Stability   :  experimental+-- Portability :+--+-- |+-- Type declarations and associated basic functions for PSCI.+--+-----------------------------------------------------------------------------++module Types where++import qualified Data.Map as M+import qualified Language.PureScript as P++data PSCiOptions = PSCiOptions+  { psciMultiLineMode     :: Bool+  , psciInputFile         :: [FilePath]+  , psciForeignInputFiles :: [FilePath]+  , psciInputNodeFlags    :: [String]+  }++-- |+-- The PSCI state.+-- Holds a list of imported modules, loaded files, and partial let bindings.+-- The let bindings are partial,+-- because it makes more sense to apply the binding to the final evaluated expression.+--+data PSCiState = PSCiState+  { psciImportedFilenames   :: [FilePath]+  , psciImportedModules     :: [ImportedModule]+  , psciLoadedModules       :: [(Either P.RebuildPolicy FilePath, P.Module)]+  , psciForeignFiles        :: M.Map P.ModuleName (FilePath, P.ForeignJS)+  , psciLetBindings         :: [P.Declaration]+  , psciNodeFlags           :: [String]+  }++-- | All of the data that is contained by an ImportDeclaration in the AST.+-- That is:+--+-- * A module name, the name of the module which is being imported+-- * An ImportDeclarationType which specifies whether there is an explicit+--   import list, a hiding list, or neither.+-- * If the module is imported qualified, its qualified name in the importing+--   module. Otherwise, Nothing.+--+type ImportedModule = (P.ModuleName, P.ImportDeclarationType, Maybe P.ModuleName)++psciImportedModuleNames :: PSCiState -> [P.ModuleName]+psciImportedModuleNames (PSCiState{psciImportedModules = is}) =+  map (\(mn, _, _) -> mn) is++allImportsOf :: P.Module -> PSCiState -> [ImportedModule]+allImportsOf m (PSCiState{psciImportedModules = is}) =+  filter isImportOfThis is+  where+  name = P.getModuleName m+  isImportOfThis (name', _, _) = name == name'++-- State helpers++-- |+-- Updates the state to have more imported modules.+--+updateImportedFiles :: FilePath -> PSCiState -> PSCiState+updateImportedFiles filename st = st { psciImportedFilenames = filename : psciImportedFilenames st }++-- |+-- Updates the state to have more imported modules.+--+updateImportedModules :: ImportedModule -> PSCiState -> PSCiState+updateImportedModules im st = st { psciImportedModules = im : psciImportedModules st }++-- |+-- Updates the state to have more loaded files.+--+updateModules :: [(Either P.RebuildPolicy FilePath, P.Module)] -> PSCiState -> PSCiState+updateModules modules st = st { psciLoadedModules = psciLoadedModules st ++ modules }++-- |+-- Updates the state to have more let bindings.+--+updateLets :: [P.Declaration] -> PSCiState -> PSCiState+updateLets ds st = st { psciLetBindings = psciLetBindings st ++ ds }++-- |+-- Updates the state to have more let bindings.+--+updateForeignFiles :: M.Map P.ModuleName (FilePath, P.ForeignJS) -> PSCiState -> PSCiState+updateForeignFiles fs st = st { psciForeignFiles = psciForeignFiles st `M.union` fs }++-- |+-- Valid Meta-commands for PSCI+--+data Command+  -- |+  -- A purescript expression+  --+  = Expression P.Expr+  -- |+  -- Show the help (ie, list of directives)+  --+  | ShowHelp+  -- |+  -- Import a module from a loaded file+  --+  | Import ImportedModule+  -- |+  -- Browse a module+  --+  | BrowseModule P.ModuleName+  -- |+  -- Load a file for use with importing+  --+  | LoadFile FilePath+  -- |+  -- Load a foreign module+  --+  | LoadForeign FilePath+  -- |+  -- Exit PSCI+  --+  | QuitPSCi+  -- |+  -- Reset the state of the REPL+  --+  | ResetState+  -- |+  -- Add some declarations to the current evaluation context.+  --+  | Decls [P.Declaration]+  -- |+  -- Find the type of an expression+  --+  | TypeOf P.Expr+  -- |+  -- Find the kind of an expression+  --+  | KindOf P.Type+  -- |+  -- Shows information about the current state of the REPL+  --+  | ShowInfo ReplQuery++data ReplQuery+  = QueryLoaded+  | QueryImport+  deriving (Eq, Show)++-- | A list of all ReplQuery values.+replQueries :: [ReplQuery]+replQueries = [QueryLoaded, QueryImport]++replQueryStrings :: [String]+replQueryStrings = map showReplQuery replQueries++showReplQuery :: ReplQuery -> String+showReplQuery QueryLoaded = "loaded"+showReplQuery QueryImport = "import"++parseReplQuery :: String -> Maybe ReplQuery+parseReplQuery "loaded" = Just QueryLoaded+parseReplQuery "import" = Just QueryImport+parseReplQuery _ = Nothing++data Directive+  = Help+  | Quit+  | Reset+  | Browse+  | Load+  | Foreign+  | Type+  | Kind+  | Show+  deriving (Eq, Show)

+ psci/main/Main.hs view

@@ -0,0 +1,6 @@+module Main where++import PSCi++main :: IO ()+main = runPSCi

+ psci/tests/Main.hs view

@@ -0,0 +1,150 @@+{-# LANGUAGE RecordWildCards, TupleSections #-}++module Main where++import Control.Monad.Trans.State.Strict (runStateT)+import Control.Monad (when, forM)+import Control.Applicative+import Control.Monad.Writer (runWriterT)+import Control.Monad.Trans.Except (runExceptT)++import Data.List (isSuffixOf, sort)++import System.Exit (exitFailure)+import System.Console.Haskeline+import System.FilePath ((</>))+import System.Directory (getCurrentDirectory, getDirectoryContents)++import Test.HUnit++import qualified Language.PureScript as P++import PSCi+import Completion+import Types++main :: IO ()+main = do+  Counts{..} <- runTestTT allTests+  when (errors + failures > 0) exitFailure++allTests :: Test+allTests = completionTests++completionTests :: Test+completionTests =+  TestLabel "completionTests"+    (TestList (map (TestCase . assertCompletedOk) completionTestData))++-- If the cursor is at the right end of the line, with the 1st element of the+-- pair as the text in the line, then pressing tab should offer all the+-- elements of the list (which is the 2nd element) as completions.+completionTestData :: [(String, [String])]+completionTestData =+  -- basic directives+  [ (":h", [":help"])+  , (":re", [":reset"])+  , (":q", [":quit"])+  , (":mo", [":module"])+  , (":b", [":browse"])++  -- :browse should complete modules+  , (":b Prel", [":b Prelude", ":b Prelude.Unsafe"])+  , (":b Prelude.", [":b Prelude.Unsafe"])++  -- :load, :module should complete file paths+  , (":l psci/tests/data/", [":l psci/tests/data/Sample.purs"])+  , (":module psci/tests/data/", [":module psci/tests/data/Sample.purs"])++  -- :quit, :help, :reset should not complete+  , (":help ", [])+  , (":quit ", [])+  , (":reset ", [])++  -- :show should complete to "loaded" and "import"+  , (":show ", [":show import", ":show loaded"])+  , (":show a", [])++  -- :type should complete values and data constructors in scope+  , (":type Prelude.Unsafe.un", [":type Prelude.Unsafe.unsafeIndex"])+  , (":type un", [":type unit"])+  , (":type E", [":type EQ"])++  -- :kind should complete types in scope+  , (":kind C", [":kind Control.Monad.Eff.Pure"])+  , (":kind O", [":kind Ordering"])++  -- Only one argument for directives should be completed+  , (":show import ", [])+  , (":type EQ ", [])+  , (":kind Ordering ", [])++  -- import should complete module names+  , ("import Control.Monad.S", ["import Control.Monad.ST"])+  , ("import qualified Control.Monad.S", ["import qualified Control.Monad.ST"])+  , ("import Control.Monad.", map ("import Control.Monad." ++)+                                  ["Eff", "ST"])++  -- a few other import tests+  , ("impor", ["import"])+  , ("import q", ["import qualified"])+  , ("import ", map ("import " ++) allModuleNames ++ ["import qualified"])+  , ("import Prelude.Unsafe ", [])++  -- String and number literals should not be completed+  , ("\"hi", [])+  , ("34", [])++  -- Identifiers and data constructors should be completed+  , ("un", ["unit"])+  , ("Debug.Trace.", map ("Debug.Trace." ++) ["print", "trace"])+  , ("G", ["GT"])+  , ("Prelude.L", ["Prelude.LT"])++  -- if a module is imported qualified, values should complete under the+  -- qualified name, as well as the original name.+  , ("ST.new", ["ST.newSTRef"])+  , ("Control.Monad.ST.new", ["Control.Monad.ST.newSTRef"])+  ]+  where+  allModuleNames = [ "Assert"+                   , "Control.Monad.Eff"+                   , "Control.Monad.ST"+                   , "Data.Function"+                   , "Debug.Trace"+                   , "Prelude"+                   , "Prelude.Unsafe"+                   ]++assertCompletedOk :: (String, [String]) -> Assertion+assertCompletedOk (line, expecteds) = do+  (unusedR, completions) <- runCM (completion' (reverse line, ""))+  let unused = reverse unusedR+  let actuals = map ((unused ++) . replacement) completions+  sort expecteds @=? sort actuals++runCM :: CompletionM a -> IO a+runCM act = do+  psciState <- getPSCiState+  fmap fst (runStateT (liftCompletionM act) psciState)++getPSCiState :: IO PSCiState+getPSCiState = do+  cwd <- getCurrentDirectory+  let preludeDir = cwd </> "tests" </> "prelude"+      jsDir = preludeDir </> "js"+  modulesOrFirstError <- loadAllModules [ preludeDir </> "Prelude.purs" ]+  jsFiles <- map (jsDir </>) . filter (".js" `isSuffixOf`) <$> getDirectoryContents jsDir+  foreignFiles <- forM jsFiles (\f -> (f,) <$> readFile f)+  Right (foreigns, _) <- runExceptT $ runWriterT $ P.parseForeignModulesFromFiles foreignFiles+  case modulesOrFirstError of+    Left err ->+      print err >> exitFailure+    Right modules ->+      let imports = [controlMonadSTasST, (P.ModuleName [P.ProperName "Prelude"], P.Implicit, Nothing)]+      in  return (PSCiState [] imports modules foreigns [] [])++controlMonadSTasST :: ImportedModule+controlMonadSTasST = (s "Control.Monad.ST", P.Implicit, Just (s "ST"))+  where+  s = P.moduleNameFromString

purescript.cabal view

@@ -1,10 +1,10 @@ name: purescript-version: 0.6.9.5+version: 0.7.0.0 cabal-version: >=1.8 build-type: Simple license: MIT license-file: LICENSE-copyright: (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors+copyright: (c) 2013-15 Phil Freeman, (c) 2014-15 Gary Burgess maintainer: Phil Freeman <paf31@cantab.net> stability: experimental synopsis: PureScript Programming Language Compiler@@ -13,10 +13,12 @@ Homepage: http://www.purescript.org/ author: Phil Freeman <paf31@cantab.net>,         Gary Burgess <gary.burgess@gmail.com>,-        Hardy Jones <jones3.hardy@gmail.com>+        Hardy Jones <jones3.hardy@gmail.com>,+        Harry Garrood <harry@garrood.me> -extra-source-files: prelude/prelude.purs-                  , examples/passing/*.purs+tested-with: GHC==7.8++extra-source-files: examples/passing/*.purs                   , examples/failing/*.purs  source-repository head@@ -27,16 +29,25 @@     build-depends: base >=4.6 && <5,                    containers -any,                    unordered-containers -any,+                   dlist -any,                    directory >= 1.2,                    filepath -any,                    mtl >= 2.1.0 && < 2.3.0,                    parsec -any,-                   transformers >= 0.4.0 && < 0.5,+                   transformers >= 0.3.0 && < 0.5,+                   transformers-compat >= 0.3.0,                    utf8-string >= 1 && < 2,                    pattern-arrows >= 0.0.2 && < 0.1,-                   file-embed >= 0.0.7 && < 0.0.8,                    time -any,-                   boxes >= 0.1.4 && < 0.2.0+                   boxes >= 0.1.4 && < 0.2.0,+                   aeson >= 0.8 && < 0.9,+                   vector -any,+                   bower-json >= 0.7,+                   aeson-better-errors >= 0.8,+                   bytestring -any,+                   text -any,+                   split -any+     exposed-modules: Language.PureScript                      Language.PureScript.AST                      Language.PureScript.AST.Binders@@ -44,6 +55,7 @@                      Language.PureScript.AST.Operators                      Language.PureScript.AST.SourcePos                      Language.PureScript.AST.Traversals+                     Language.PureScript.AST.Exported                      Language.PureScript.CodeGen                      Language.PureScript.CodeGen.Externs                      Language.PureScript.CodeGen.JS@@ -67,10 +79,10 @@                      Language.PureScript.CoreFn.Module                      Language.PureScript.CoreFn.Traversals                      Language.PureScript.Comments-                     Language.PureScript.DeadCodeElimination                      Language.PureScript.Environment                      Language.PureScript.Errors                      Language.PureScript.Kinds+                     Language.PureScript.Linter                      Language.PureScript.ModuleDependencies                      Language.PureScript.Names                      Language.PureScript.Options@@ -78,6 +90,7 @@                      Language.PureScript.Parser.Lexer                      Language.PureScript.Parser.Common                      Language.PureScript.Parser.Declarations+                     Language.PureScript.Parser.JS                      Language.PureScript.Parser.Kinds                      Language.PureScript.Parser.State                      Language.PureScript.Parser.Types@@ -111,9 +124,21 @@                      Language.PureScript.TypeClassDictionaries                      Language.PureScript.Types +                     Language.PureScript.Docs+                     Language.PureScript.Docs.Convert+                     Language.PureScript.Docs.Render+                     Language.PureScript.Docs.Types+                     Language.PureScript.Docs.RenderedCode+                     Language.PureScript.Docs.RenderedCode.Types+                     Language.PureScript.Docs.RenderedCode.Render+                     Language.PureScript.Docs.AsMarkdown+                     Language.PureScript.Docs.ParseAndDesugar+                     Language.PureScript.Docs.Utils.MonoidExtras+                      Control.Monad.Unify                      Control.Monad.Supply                      Control.Monad.Supply.Class+     exposed: True     buildable: True     hs-source-dirs: src@@ -123,40 +148,36 @@ executable psc     build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,                    mtl -any, optparse-applicative >= 0.10.0, parsec -any, purescript -any,-                   transformers -any+                   time -any, transformers -any, transformers-compat -any, Glob >= 0.7 && < 0.8     main-is: Main.hs     buildable: True     hs-source-dirs: psc-    other-modules:-    ghc-options: -Wall -O2 -fno-warn-unused-do-bind--executable psc-make-    build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,-                   mtl -any, optparse-applicative >= 0.10.0, parsec -any, purescript -any,-                   transformers -any-    main-is: Main.hs-    buildable: True-    hs-source-dirs: psc-make-    other-modules:+    other-modules: Make     ghc-options: -Wall -O2 -fno-warn-unused-do-bind  executable psci     build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,                    mtl -any, optparse-applicative >= 0.10.0, parsec -any,                    haskeline >= 0.7.0.0, purescript -any, transformers -any,-                   process -any+                   transformers-compat -any, process -any, time -any, Glob -any      main-is: Main.hs     buildable: True-    hs-source-dirs: psci-    other-modules: Commands+    hs-source-dirs: psci psci/main+    other-modules: Types                    Parser                    Directive+                   Completion+                   PSCi+                   Make+                   IO     ghc-options: -Wall -O2  executable psc-docs     build-depends: base >=4 && <5, purescript -any,-                   optparse-applicative >= 0.10.0, process -any, mtl -any+                   optparse-applicative >= 0.10.0, process -any, mtl -any,+                   split -any, ansi-wl-pprint -any, directory -any, +                   filepath -any, Glob -any     main-is: Main.hs     buildable: True     hs-source-dirs: psc-docs@@ -165,20 +186,67 @@                    Tags     ghc-options: -Wall -O2 +executable psc-publish+    build-depends: base >=4 && <5, purescript -any,+                   optparse-applicative >= 0.10.0, process -any, mtl -any,+                   pattern-arrows -any, aeson -any, bytestring -any,+                   directory -any, transformers -any, text -any, containers+                   -any, boxes -any, split -any, Glob -any, aeson-better-errors+                   -any, transformers-compat -any, bower-json -any, semigroups+                   -any, safe -any+    main-is: Main.hs+    buildable: True+    hs-source-dirs: psc-publish+    other-modules: Utils+                   ErrorsWarnings+                   BoxesHelpers+    ghc-options: -Wall -O2+ executable psc-hierarchy     build-depends: base >=4 && <5, purescript -any, optparse-applicative >= 0.10.0,-                   process -any, mtl -any, parsec -any, filepath -any, directory -any+                   process -any, mtl -any, parsec -any, filepath -any, directory -any, +                   Glob -any     main-is: Main.hs     buildable: True     hs-source-dirs: hierarchy     other-modules:     ghc-options: -Wall -O2 +executable psc-bundle+  main-is:             Main.hs+  other-modules:+  other-extensions:+  build-depends:       base >=4 && <5,+                       language-javascript == 0.5.*,+                       syb -any,+                       containers -any,+                       filepath -any,+                       directory -any,+                       mtl -any,+                       transformers -any,+                       transformers-compat -any, +                       optparse-applicative >= 0.10.0,+                       Glob -any+  ghc-options:         -Wall -O2+  hs-source-dirs:      psc-bundle+ test-suite tests     build-depends: base >=4 && <5, containers -any, directory -any,                    filepath -any, mtl -any, parsec -any, purescript -any,-                   transformers -any, process -any+                   transformers -any, process -any, transformers-compat -any, time -any     type: exitcode-stdio-1.0     main-is: Main.hs     buildable: True     hs-source-dirs: tests++test-suite psci-tests+    build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,+                   mtl -any, optparse-applicative >= 0.10.0, parsec -any,+                   haskeline >= 0.7.0.0, purescript -any, transformers -any,+                   transformers-compat -any, process -any, HUnit -any, time -any, +                   Glob -any+    type: exitcode-stdio-1.0+    main-is: Main.hs+    buildable: True+    hs-source-dirs: psci psci/tests+    ghc-options: -Wall

src/Control/Monad/Supply.hs view

@@ -21,7 +21,7 @@  import Control.Applicative import Control.Monad.State-import Control.Monad.Except+import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.Reader import Control.Monad.Writer

src/Control/Monad/Unify.hs view

@@ -27,7 +27,7 @@  import Control.Applicative import Control.Monad.State-import Control.Monad.Error.Class+import Control.Monad.Error.Class (MonadError(..))  import Data.HashMap.Strict as M

src/Language/PureScript.hs view

@@ -14,47 +14,43 @@ -----------------------------------------------------------------------------  {-# LANGUAGE DataKinds #-}-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}  module Language.PureScript   ( module P-  , compile-  , compile'   , RebuildPolicy(..)-  , MonadMake(..)+  , MakeActions(..)+  , SupplyVar()+  , Externs()   , make-  , prelude   , version   ) where -import Data.FileEmbed (embedFile) import Data.Function (on)-import Data.List (sortBy, groupBy, intercalate)+import Data.List (sortBy, groupBy) import Data.Maybe (fromMaybe) import Data.Time.Clock import Data.Version (Version)-import qualified Data.Traversable as T (traverse)-import qualified Data.ByteString.UTF8 as BU import qualified Data.Map as M import qualified Data.Set as S  import Control.Applicative import Control.Arrow ((&&&))-import Control.Monad.Except+import Control.Monad+import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.Reader--import System.FilePath ((</>))+import Control.Monad.Writer+import Control.Monad.Supply.Class (fresh)  import Language.PureScript.AST as P import Language.PureScript.Comments as P-import Language.PureScript.CodeGen as P-import Language.PureScript.DeadCodeElimination as P+import Language.PureScript.CodeGen.Externs (moduleToPs) import Language.PureScript.Environment as P import Language.PureScript.Errors as P import Language.PureScript.Kinds as P+import Language.PureScript.Linter as P import Language.PureScript.ModuleDependencies as P import Language.PureScript.Names as P import Language.PureScript.Options as P@@ -71,86 +67,46 @@ import qualified Paths_purescript as Paths  -- |--- Compile a collection of modules------ The compilation pipeline proceeds as follows:------  * Sort the modules based on module dependencies, checking for cyclic dependencies.------  * Perform a set of desugaring passes.------  * Type check, and elaborate values to include type annotations and type class dictionaries.------  * Regroup values to take into account new value dependencies introduced by elaboration.------  * Eliminate dead code.------  * Generate Javascript, and perform optimization passes.------  * Pretty-print the generated Javascript----compile :: (Functor m, Applicative m, MonadError String m, MonadReader (Options Compile) m)-        => [Module] -> [String] -> m (String, String, Environment)-compile = compile' initEnvironment--compile' :: (Functor m, Applicative m, MonadError String m, MonadReader (Options Compile) m)-         => Environment -> [Module] -> [String] -> m (String, String, Environment)-compile' env ms prefix = do-  noPrelude <- asks optionsNoPrelude-  additional <- asks optionsAdditional-  mainModuleIdent <- asks (fmap moduleNameFromString . optionsMain)-  (sorted, _) <- sortModules $ map importPrim $ if noPrelude then ms else map importPrelude ms-  (desugared, nextVar) <- interpretMultipleErrors True $ runSupplyT 0 $ desugar sorted-  (elaborated, env') <- runCheck' env $ forM desugared $ typeCheckModule mainModuleIdent-  regrouped <- interpretMultipleErrors True $ createBindingGroupsModule . collapseBindingGroupsModule $ elaborated-  let corefn = map (CoreFn.moduleToCoreFn env') regrouped-  let entryPoints = moduleNameFromString `map` entryPointModules additional-  let elim = if null entryPoints then corefn else eliminateDeadCode entryPoints corefn-  let renamed = renameInModules elim-  let codeGenModuleNames = moduleNameFromString `map` codeGenModules additional-  let modulesToCodeGen = if null codeGenModuleNames then renamed else filter (\(CoreFn.Module _ mn _ _ _ _) -> mn `elem` codeGenModuleNames) renamed-  js <- concat <$> (evalSupplyT nextVar $ T.traverse moduleToJs modulesToCodeGen)-  let exts = intercalate "\n" . map (`moduleToPs` env') $ regrouped-  js' <- generateMain env' js-  let pjs = unlines $ map ("// " ++) prefix ++ [prettyPrintJS js']-  return (pjs, exts, env')--generateMain :: (MonadError String m, MonadReader (Options Compile) m) => Environment -> [JS] -> m [JS]-generateMain env js = do-  main <- asks optionsMain-  additional <- asks optionsAdditional-  case moduleNameFromString <$> main of-    Just mmi -> do-      when ((mmi, Ident C.main) `M.notMember` names env) $-        throwError $ show mmi ++ "." ++ C.main ++ " is undefined"-      return $ js ++ [JSApp (JSAccessor C.main (JSAccessor (moduleNameToJs mmi) (JSVar (browserNamespace additional)))) []]-    _ -> return js---- |--- A type class which collects the IO actions we need to be able to run in "make" mode+-- Actions that require implementations when running in "make" mode. ---class (MonadReader (P.Options P.Make) m, MonadError String m) => MonadMake m where+data MakeActions m = MakeActions {   -- |-  -- Get a file timestamp+  -- Get the timestamp for the input file(s) for a module. If there are multiple+  -- files (.purs and foreign files, for example) the timestamp should be for+  -- the most recently modified file.   ---  getTimestamp :: FilePath -> m (Maybe UTCTime)-+    getInputTimestamp :: ModuleName -> m (Either RebuildPolicy (Maybe UTCTime))   -- |-  -- Read a file as a string+  -- Get the timestamp for the output files for a module. This should be the+  -- timestamp for the oldest modified file, or Nothing if any of the required+  -- output files are missing.   ---  readTextFile :: FilePath -> m String-+  , getOutputTimestamp :: ModuleName -> m (Maybe UTCTime)   -- |-  -- Write a text file+  -- Read the externs file for a module as a string and also return the actual+  -- path for the file.+  , readExterns :: ModuleName -> m (FilePath, String)+  -- |+  -- Run the code generator for the module and write any required output files.   ---  writeTextFile :: FilePath -> String -> m ()-+  , codegen :: CoreFn.Module CoreFn.Ann -> Environment -> SupplyVar -> Externs -> m ()   -- |-  -- Respond to a progress update+  -- Respond to a progress update.   ---  progress :: String -> m ()+  , progress :: String -> m ()+  }  -- |+-- Generated code for an externs file.+--+type Externs = String++-- |+-- A value to be used in the Supply monad.+--+type SupplyVar = Integer++-- | -- Determines when to rebuild a module -- data RebuildPolicy@@ -159,76 +115,47 @@   -- | Always rebuild this module   | RebuildAlways deriving (Show, Eq, Ord) --- Traverse (Either e) instance (base 4.7)-traverseEither :: Applicative f => (a -> f b) -> Either e a -> f (Either e b)-traverseEither _ (Left x) = pure (Left x)-traverseEither f (Right y) = Right <$> f y- -- | -- Compiles in "make" mode, compiling each module separately to a js files and an externs file -- -- If timestamps have not changed, the externs file can be used to provide the module's types without -- having to typecheck the module again. ---make :: forall m. (Functor m, Applicative m, Monad m, MonadMake m)-     => FilePath -> [(Either RebuildPolicy FilePath, Module)] -> [String] -> m Environment-make outputDir ms prefix = do-  noPrelude <- asks optionsNoPrelude-  let filePathMap = M.fromList (map (\(fp, Module _ mn _ _) -> (mn, fp)) ms)--  (sorted, graph) <- sortModules $ map importPrim $ if noPrelude then map snd ms else map (importPrelude . snd) ms-+make :: forall m. (Functor m, Applicative m, Monad m, MonadReader P.Options m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)+     => MakeActions m+     -> [(Either RebuildPolicy FilePath, Module)]+     -> m Environment+make MakeActions{..} ms = do+  (sorted, graph) <- sortModules $ map (importPrim . snd) ms+  mapM_ lint sorted   toRebuild <- foldM (\s (Module _ moduleName' _ _) -> do-    let filePath = runModuleName moduleName'--        jsFile = outputDir </> filePath </> "index.js"-        externsFile = outputDir </> filePath </> "externs.purs"-        inputFile = fromMaybe (error "Module has no filename in 'make'") $ M.lookup moduleName' filePathMap--    jsTimestamp <- getTimestamp jsFile-    externsTimestamp <- getTimestamp externsFile-    inputTimestamp <- traverseEither getTimestamp inputFile--    return $ case (inputTimestamp, jsTimestamp, externsTimestamp) of-      (Right (Just t1), Just t2, Just t3) | t1 < min t2 t3 -> s-      (Left RebuildNever, Just _, Just _) -> s+    inputTimestamp <- getInputTimestamp moduleName'+    outputTimestamp <- getOutputTimestamp moduleName'+    return $ case (inputTimestamp, outputTimestamp) of+      (Right (Just t1), Just t2) | t1 < t2 -> s+      (Left RebuildNever, Just _) -> s       _ -> S.insert moduleName' s) S.empty sorted    marked <- rebuildIfNecessary (reverseDependencies graph) toRebuild sorted--  (desugared, nextVar) <- interpretMultipleErrors True $ runSupplyT 0 $ zip (map fst marked) <$> desugar (map snd marked)-+  (desugared, nextVar) <- runSupplyT 0 $ zip (map fst marked) <$> desugar (map snd marked)   evalSupplyT nextVar $ go initEnvironment desugared-   where+   go :: Environment -> [(Bool, Module)] -> SupplyT m Environment   go env [] = return env   go env ((False, m) : ms') = do     (_, env') <- lift . runCheck' env $ typeCheckModule Nothing m-     go env' ms'   go env ((True, m@(Module coms moduleName' _ exps)) : ms') = do-    let filePath = runModuleName moduleName'-        jsFile = outputDir </> filePath </> "index.js"-        externsFile = outputDir </> filePath </> "externs.purs"--    lift . progress $ "Compiling " ++ runModuleName moduleName'-+    lift $ progress $ "Compiling " ++ runModuleName moduleName'     (Module _ _ elaborated _, env') <- lift . runCheck' env $ typeCheckModule Nothing m--    regrouped <- interpretMultipleErrors True . createBindingGroups moduleName' . collapseBindingGroups $ elaborated-+    regrouped <- createBindingGroups moduleName' . collapseBindingGroups $ elaborated     let mod' = Module coms moduleName' regrouped exps-    let corefn = CoreFn.moduleToCoreFn env' mod'-    let [renamed] = renameInModules [corefn]--    pjs <- prettyPrintJS <$> moduleToJs renamed-    let js = unlines $ map ("// " ++) prefix ++ [pjs]-    let exts = unlines $ map ("-- " ++) prefix ++ [moduleToPs mod' env']--    lift $ writeTextFile jsFile js-    lift $ writeTextFile externsFile exts-+        corefn = CoreFn.moduleToCoreFn env' mod'+        [renamed] = renameInModules [corefn]+        exts = moduleToPs mod' env'+    nextVar <- fresh+    lift $ codegen renamed env' nextVar exts     go env' ms'    rebuildIfNecessary :: M.Map ModuleName [ModuleName] -> S.Set ModuleName -> [Module] -> m [(Bool, Module)]@@ -238,12 +165,16 @@         toRebuild' = toRebuild `S.union` S.fromList deps     (:) (True, m) <$> rebuildIfNecessary graph toRebuild' ms'   rebuildIfNecessary graph toRebuild (Module _ moduleName' _ _ : ms') = do-    let externsFile = outputDir </> runModuleName moduleName' </> "externs.purs"-    externs <- readTextFile externsFile-    externsModules <- fmap (map snd) . either (throwError . show) return $ P.parseModulesFromFiles id [(externsFile, externs)]+    (path, externs) <- readExterns moduleName'+    externsModules <- fmap (map snd) . alterErrors $ P.parseModulesFromFiles id [(path, externs)]     case externsModules of       [m'@(Module _ moduleName'' _ _)] | moduleName'' == moduleName' -> (:) (False, m') <$> rebuildIfNecessary graph toRebuild ms'-      _ -> throwError $ "Externs file " ++ externsFile ++ " was invalid"+      _ -> throwError . errorMessage . InvalidExternsFile $ path+    where+    alterErrors = flip catchError $ \(MultipleErrors errs) ->+      throwError . MultipleErrors $ flip map errs $ \e -> case e of+        SimpleErrorWrapper (ErrorParsingModule err) -> SimpleErrorWrapper (ErrorParsingExterns err)+        _ -> e  reverseDependencies :: ModuleGraph -> M.Map ModuleName [ModuleName] reverseDependencies g = combine [ (dep, mn) | (mn, deps) <- g, dep <- deps ]@@ -265,12 +196,6 @@  importPrim :: Module -> Module importPrim = addDefaultImport (ModuleName [ProperName C.prim])--importPrelude :: Module -> Module-importPrelude = addDefaultImport (ModuleName [ProperName C.prelude])--prelude :: String-prelude = BU.toString $(embedFile "prelude/prelude.purs")  version :: Version version = Paths.version

src/Language/PureScript/AST.hs view

@@ -21,3 +21,4 @@ import Language.PureScript.AST.Operators as AST import Language.PureScript.AST.SourcePos as AST import Language.PureScript.AST.Traversals as AST+import Language.PureScript.AST.Exported as AST

src/Language/PureScript/AST/Binders.hs view

@@ -39,6 +39,10 @@   --   | StringBinder String   -- |+  -- A binder which matches a character literal+  --+  | CharBinder Char+  -- |   -- A binder which matches a numeric literal   --   | NumberBinder (Either Integer Double)@@ -59,10 +63,6 @@   --   | ArrayBinder [Binder]   -- |-  -- A binder which matches an array and binds its head and tail-  ---  | ConsBinder Binder Binder-  -- |   -- A binder which binds its input to an identifier   --   | NamedBinder Ident Binder@@ -81,7 +81,6 @@   go ns (ConstructorBinder _ bs) = foldl go ns bs   go ns (ObjectBinder bs) = foldl go ns (map snd bs)   go ns (ArrayBinder bs) = foldl go ns bs-  go ns (ConsBinder b1 b2) = go (go ns b1) b2   go ns (NamedBinder name b) = go (name : ns) b   go ns (PositionedBinder _ _ b) = go ns b   go ns _ = ns

src/Language/PureScript/AST/Declarations.hs view

@@ -17,6 +17,7 @@ module Language.PureScript.AST.Declarations where  import qualified Data.Data as D+import qualified Data.Map as M  import Language.PureScript.AST.Binders import Language.PureScript.AST.Operators@@ -26,7 +27,6 @@ import Language.PureScript.Kinds import Language.PureScript.TypeClassDictionaries import Language.PureScript.Comments-import Language.PureScript.CodeGen.JS.AST import Language.PureScript.Environment  -- |@@ -41,53 +41,6 @@ getModuleName (Module _ name _ _) = name  -- |--- Test if a declaration is exported, given a module's export list.----isExported :: Maybe [DeclarationRef] -> Declaration -> Bool-isExported Nothing _ = True-isExported _ TypeInstanceDeclaration{} = True-isExported exps (PositionedDeclaration _ _ d) = isExported exps d-isExported (Just exps) decl = any (matches decl) 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 (TypeSynonymDeclaration ident _ _) (TypeRef ident' _) = ident == ident'-  matches (TypeClassDeclaration ident _ _ _) (TypeClassRef ident') = ident == ident'-  matches (PositionedDeclaration _ _ d) r = d `matches` r-  matches d (PositionedDeclarationRef _ _ r) = d `matches` r-  matches _ _ = False--exportedDeclarations :: Module -> [Declaration]-exportedDeclarations (Module _ _ decls exps) = filter (isExported exps) (flattenDecls decls)---- |--- Test if a data constructor for a given type is exported, given a module's export list.----isDctorExported :: ProperName -> Maybe [DeclarationRef] -> ProperName -> Bool-isDctorExported _ Nothing _ = True-isDctorExported ident (Just exps) ctor = test `any` exps-  where-  test (PositionedDeclarationRef _ _ d) = test d-  test (TypeRef ident' Nothing) = ident == ident'-  test (TypeRef ident' (Just ctors)) = ident == ident' && ctor `elem` ctors-  test _ = False---- |--- Return the exported data constructors for a given type.----exportedDctors :: Module -> ProperName -> [ProperName]-exportedDctors (Module _ _ decls exps) ident =-  filter (isDctorExported ident exps) dctors-  where-  dctors = concatMap getDctors (flattenDecls decls)-  getDctors (DataDeclaration _ _ _ ctors) = map fst ctors-  getDctors (PositionedDeclaration _ _ d) = getDctors d-  getDctors _ = []---- | -- An item in a list of explicit imports or exports -- data DeclarationRef@@ -108,6 +61,10 @@   --   | TypeInstanceRef Ident   -- |+  -- A module, in its entirety+  --+  | ModuleRef ModuleName+  -- |   -- A declaration reference with source position information   --   | PositionedDeclarationRef SourceSpan [Comment] DeclarationRef@@ -118,6 +75,7 @@   (ValueRef name)        == (ValueRef name')        = name == name'   (TypeClassRef name)    == (TypeClassRef name')    = name == name'   (TypeInstanceRef name) == (TypeInstanceRef name') = name == name'+  (ModuleRef name) == (ModuleRef name') = name == name'   (PositionedDeclarationRef _ _ r) == r' = r == r'   r == (PositionedDeclarationRef _ _ r') = r == r'   _ == _ = False@@ -169,9 +127,9 @@   --   | BindingGroupDeclaration [(Ident, NameKind, Expr)]   -- |-  -- A foreign import declaration (type, name, optional inline Javascript, type)+  -- A foreign import declaration (name, type)   ---  | ExternDeclaration ForeignImportType Ident (Maybe JS) Type+  | ExternDeclaration Ident Type   -- |   -- A data type foreign import (name, kind)   --@@ -302,6 +260,10 @@   --   | StringLiteral String   -- |+  -- A character literal+  --+  | CharLiteral Char+  -- |   -- A boolean literal   --   | BooleanLiteral Bool@@ -404,7 +366,7 @@   -- at superclass implementations when searching for a dictionary, the type class name and   -- instance type, and the type class dictionaries in scope.   ---  | TypeClassDictionary Bool Constraint [TypeClassDictionaryInScope]+  | TypeClassDictionary Bool Constraint (M.Map (Maybe ModuleName) (M.Map (Qualified ProperName) (M.Map (Qualified Ident) TypeClassDictionaryInScope)))   -- |   -- A typeclass dictionary accessor, the implementation is left unspecified until CoreFn desugaring.   --

+ src/Language/PureScript/AST/Exported.hs view

@@ -0,0 +1,136 @@++module Language.PureScript.AST.Exported (+  exportedDeclarations,+  isExported+) where++import Control.Category ((>>>))+import Data.Maybe (mapMaybe)++import Language.PureScript.AST.Declarations+import Language.PureScript.Types+import Language.PureScript.Names++-- |+-- Return a list of all declarations which are exported from a module.+-- This function descends into data declarations to filter out unexported+-- data constructors, and also filters out type instance declarations if+-- they refer to classes or types which are not themselves exported.+--+-- Note that this function assumes that the module has already had its imports+-- desugared using 'Language.PureScript.Sugar.Names.desugarImports'. It will+-- produce incorrect results if this is not the case - for example, type class+-- instances will be incorrectly removed in some cases.+--+exportedDeclarations :: Module -> [Declaration]+exportedDeclarations (Module _ _ decls exps) = go decls+  where+  go = flattenDecls+        >>> filter (isExported exps)+        >>> map (filterDataConstructors exps)+        >>> filterInstances exps++-- |+-- Filter out all data constructors from a declaration which are not exported.+-- If the supplied declaration is not a data declaration, this function returns+-- it unchanged.+--+filterDataConstructors :: Maybe [DeclarationRef] -> Declaration -> Declaration+filterDataConstructors exps (DataDeclaration dType tyName tyArgs dctors) =+  DataDeclaration dType tyName tyArgs $+    filter (isDctorExported tyName exps . fst) dctors+filterDataConstructors exps (PositionedDeclaration srcSpan coms d) =+  PositionedDeclaration srcSpan coms (filterDataConstructors exps d)+filterDataConstructors _ other = other++-- |+-- Filter out all the type instances from a list of declarations which+-- reference a type or type class which is both local and not exported.+--+-- Note that this function assumes that the module has already had its imports+-- desugared using "Language.PureScript.Sugar.Names.desugarImports". It will+-- produce incorrect results if this is not the case - for example, type class+-- instances will be incorrectly removed in some cases.+--+filterInstances :: Maybe [DeclarationRef] -> [Declaration] -> [Declaration]+filterInstances Nothing = id+filterInstances (Just exps) =+  let refs = mapMaybe typeName exps ++ mapMaybe typeClassName exps+  in filter (all (visibleOutside refs) . typeInstanceConstituents)+  where+  -- Given a Qualified ProperName, and a list of all exported types and type+  -- classes, returns whether the supplied Qualified ProperName is visible+  -- outside this module. This is true if one of the following hold:+  --+  --  * the name is defined in the same module and is exported,+  --  * the name is defined in a different module (and must be exported from+  --    that module; the code would fail to compile otherwise).+  visibleOutside _ (Qualified (Just _) _) = True+  visibleOutside refs (Qualified Nothing n) = any (== n) refs++  typeName (TypeRef n _) = Just n+  typeName (PositionedDeclarationRef _ _ r) = typeName r+  typeName _ = Nothing++  typeClassName (TypeClassRef n) = Just n+  typeClassName (PositionedDeclarationRef _ _ r) = typeClassName r+  typeClassName _ = Nothing++-- |+-- Get all type and type class names referenced by a type instance declaration.+--+typeInstanceConstituents :: Declaration -> [Qualified ProperName]+typeInstanceConstituents (TypeInstanceDeclaration _ constraints className tys _) =+  className : (concatMap fromConstraint constraints ++ concatMap fromType tys)+  where++  fromConstraint (name, tys') = name : concatMap fromType tys'+  fromType = everythingOnTypes (++) go++  -- Note that type synonyms are disallowed in instance declarations, so+  -- we don't need to handle them here.+  go (TypeConstructor n) = [n]+  go (ConstrainedType cs _) = concatMap fromConstraint cs+  go _ = []++typeInstanceConstituents (PositionedDeclaration _ _ d) = typeInstanceConstituents d+typeInstanceConstituents _ = []+++-- |+-- Test if a declaration is exported, given a module's export list. Note that+-- this function does not account for type instance declarations of+-- non-exported types, or non-exported data constructors. Therefore, you should+-- prefer 'exportedDeclarations' to this function, where possible.+--+isExported :: Maybe [DeclarationRef] -> Declaration -> Bool+isExported Nothing _ = True+isExported _ TypeInstanceDeclaration{} = True+isExported exps (PositionedDeclaration _ _ d) = isExported exps d+isExported (Just exps) decl = any (matches decl) exps+  where+  matches (TypeDeclaration ident _)          (ValueRef ident')     = ident == ident'+  matches (ValueDeclaration ident _ _ _)     (ValueRef ident')     = ident == ident'+  matches (ExternDeclaration ident _)        (ValueRef ident')     = ident == ident'+  matches (FixityDeclaration _ name)         (ValueRef ident')     = name == runIdent ident'+  matches (DataDeclaration _ ident _ _)      (TypeRef ident' _)    = ident == ident'+  matches (ExternDataDeclaration ident _)    (TypeRef ident' _)    = ident == ident'+  matches (TypeSynonymDeclaration ident _ _) (TypeRef ident' _)    = ident == ident'+  matches (TypeClassDeclaration ident _ _ _) (TypeClassRef ident') = ident == ident'++  matches (PositionedDeclaration _ _ d) r = d `matches` r+  matches d (PositionedDeclarationRef _ _ r) = d `matches` r+  matches _ _ = False++-- |+-- Test if a data constructor for a given type is exported, given a module's+-- export list. Prefer 'exportedDeclarations' to this function, where possible.+--+isDctorExported :: ProperName -> Maybe [DeclarationRef] -> ProperName -> Bool+isDctorExported _ Nothing _ = True+isDctorExported ident (Just exps) ctor = test `any` exps+  where+  test (PositionedDeclarationRef _ _ d) = test d+  test (TypeRef ident' Nothing) = ident == ident'+  test (TypeRef ident' (Just ctors)) = ident == ident' && ctor `elem` ctors+  test _ = False

src/Language/PureScript/AST/Operators.hs view

@@ -12,11 +12,14 @@ -- ----------------------------------------------------------------------------- +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable #-}  module Language.PureScript.AST.Operators where  import qualified Data.Data as D+import Data.Aeson ((.=))+import qualified Data.Aeson as A  -- | -- A precedence level for an infix operator@@ -26,14 +29,23 @@ -- | -- Associativity for infix operators ---data Associativity = Infixl | Infixr | Infix deriving (D.Data, D.Typeable)+data Associativity = Infixl | Infixr | Infix deriving (Eq, Ord, D.Data, D.Typeable)  instance Show Associativity where   show Infixl = "infixl"   show Infixr = "infixr"   show Infix  = "infix" +instance A.ToJSON Associativity where+  toJSON = A.toJSON . show+ -- | -- Fixity data for infix operators ---data Fixity = Fixity Associativity Precedence deriving (Show, D.Data, D.Typeable)+data Fixity = Fixity Associativity Precedence deriving (Show, Eq, Ord, D.Data, D.Typeable)++instance A.ToJSON Fixity where+  toJSON (Fixity associativity precedence) =+    A.object [ "associativity" .= associativity+             , "precedence" .= precedence+             ]

src/Language/PureScript/AST/SourcePos.hs view

@@ -12,11 +12,13 @@ -- ----------------------------------------------------------------------------- -{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-}+{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables, RecordWildCards, OverloadedStrings #-}  module Language.PureScript.AST.SourcePos where  import qualified Data.Data as D+import Data.Aeson ((.=))+import qualified Data.Aeson as A  -- | -- Source position information@@ -30,11 +32,17 @@     -- Column number     --   , sourcePosColumn :: Int-  } deriving (Eq, D.Data, D.Typeable)+  } deriving (Eq, Ord, Show, D.Data, D.Typeable) -instance Show SourcePos where-  show sp = "line " ++ show (sourcePosLine sp) ++ ", column " ++ show (sourcePosColumn sp)+displaySourcePos :: SourcePos -> String+displaySourcePos sp =+  "line " ++ show (sourcePosLine sp) +++    ", column " ++ show (sourcePosColumn sp) +instance A.ToJSON SourcePos where+  toJSON SourcePos{..} =+    A.toJSON [sourcePosLine, sourcePosColumn]+ data SourceSpan = SourceSpan   { -- |     -- Source name@@ -47,7 +55,17 @@     -- End of the span     --   , spanEnd :: SourcePos-  } deriving (Eq, D.Data, D.Typeable)+  } deriving (Eq, Ord, Show, D.Data, D.Typeable) -instance Show SourceSpan where-  show sp = spanName sp ++ " " ++ show (spanStart sp) ++ " - " ++ show (spanEnd sp)+displaySourceSpan :: SourceSpan -> String+displaySourceSpan sp =+  spanName sp ++ " " +++    displaySourcePos (spanStart sp) ++ " - " +++    displaySourcePos (spanEnd sp)++instance A.ToJSON SourceSpan where+  toJSON SourceSpan{..} =+    A.object [ "name"  .= spanName+             , "start" .= spanStart+             , "end"   .= spanEnd+             ]

src/Language/PureScript/AST/Traversals.hs view

@@ -68,7 +68,6 @@   h' (ConstructorBinder ctor bs) = h (ConstructorBinder ctor (map h' bs))   h' (ObjectBinder bs) = h (ObjectBinder (map (fmap h') bs))   h' (ArrayBinder bs) = h (ArrayBinder (map h' bs))-  h' (ConsBinder b1 b2) = h (ConsBinder (h' b1) (h' b2))   h' (NamedBinder name b) = h (NamedBinder name (h' b))   h' (PositionedBinder pos com b) = h (PositionedBinder pos com (h' b))   h' other = h other@@ -125,7 +124,6 @@   h' (ConstructorBinder ctor bs) = ConstructorBinder ctor <$> mapM (h' <=< h) bs   h' (ObjectBinder bs) = ObjectBinder <$> mapM (sndM (h' <=< h)) bs   h' (ArrayBinder bs) = ArrayBinder <$> mapM (h' <=< h) bs-  h' (ConsBinder b1 b2) = ConsBinder <$> (h b1 >>= h') <*> (h b2 >>= h')   h' (NamedBinder name b) = NamedBinder name <$> (h b >>= h')   h' (PositionedBinder pos com b) = PositionedBinder pos com <$> (h b >>= h')   h' other = h other@@ -178,7 +176,6 @@   h' (ConstructorBinder ctor bs) = (ConstructorBinder ctor <$> mapM h' bs) >>= h   h' (ObjectBinder bs) = (ObjectBinder <$> mapM (sndM h') bs) >>= h   h' (ArrayBinder bs) = (ArrayBinder <$> mapM h' bs) >>= h-  h' (ConsBinder b1 b2) = (ConsBinder <$> h' b1 <*> h' b2) >>= h   h' (NamedBinder name b) = (NamedBinder name <$> h' b) >>= h   h' (PositionedBinder pos com b) = (PositionedBinder pos com <$> h' b) >>= h   h' other = h other@@ -234,7 +231,6 @@   h' b@(ConstructorBinder _ bs) = foldl (<>) (h b) (map h' bs)   h' b@(ObjectBinder bs) = foldl (<>) (h b) (map (h' . snd) bs)   h' b@(ArrayBinder bs) = foldl (<>) (h b) (map h' bs)-  h' b@(ConsBinder b1 b2) = h b <> h' b1 <> h' b2   h' b@(NamedBinder _ b1) = h b <> h' b1   h' b@(PositionedBinder _ _ b1) = h b <> h' b1   h' b = h b@@ -303,7 +299,6 @@   h' s (ConstructorBinder _ bs) = foldl (<>) r0 (map (h'' s) bs)   h' s (ObjectBinder bs) = foldl (<>) r0 (map (h'' s . snd) bs)   h' s (ArrayBinder bs) = foldl (<>) r0 (map (h'' s) bs)-  h' s (ConsBinder b1 b2) = h'' s b1 <> h'' s b2   h' s (NamedBinder _ b1) = h'' s b1   h' s (PositionedBinder _ _ b1) = h'' s b1   h' _ _ = r0@@ -373,7 +368,6 @@   h' s (ConstructorBinder ctor bs) = ConstructorBinder ctor <$> mapM (h'' s) bs   h' s (ObjectBinder bs) = ObjectBinder <$> mapM (sndM (h'' s)) bs   h' s (ArrayBinder bs) = ArrayBinder <$> mapM (h'' s) bs-  h' s (ConsBinder b1 b2) = ConsBinder <$> h'' s b1 <*> h'' s b2   h' s (NamedBinder name b) = NamedBinder name <$> h'' s b   h' s (PositionedBinder pos com b) = PositionedBinder pos com <$> h'' s b   h' _ other = return other@@ -393,7 +387,7 @@ accumTypes f = everythingOnValues mappend forDecls forValues (const mempty) (const mempty) (const mempty)   where   forDecls (DataDeclaration _ _ _ dctors) = mconcat (concatMap (map f . snd) dctors)-  forDecls (ExternDeclaration _ _ _ ty) = f ty+  forDecls (ExternDeclaration _ ty) = f ty   forDecls (ExternInstanceDeclaration _ cs _ tys) = mconcat (concatMap (map f . snd) cs) `mappend` mconcat (map f tys)   forDecls (TypeClassDeclaration _ _ implies _) = mconcat (concatMap (map f . snd) implies)   forDecls (TypeInstanceDeclaration _ cs _ tys _) = mconcat (concatMap (map f . snd) cs) `mappend` mconcat (map f tys)

src/Language/PureScript/CodeGen/Externs.hs view

@@ -24,13 +24,13 @@ import Control.Monad.Writer  import Language.PureScript.AST+import Language.PureScript.Comments import Language.PureScript.Environment import Language.PureScript.Kinds import Language.PureScript.Names import Language.PureScript.Pretty import Language.PureScript.TypeClassDictionaries import Language.PureScript.Types-import Language.PureScript.Comments  -- | -- Generate foreign imports for all declarations in a module@@ -38,11 +38,24 @@ moduleToPs :: Module -> Environment -> String moduleToPs (Module _ _ _ Nothing) _ = error "Module exports were not elaborated in moduleToPs" moduleToPs (Module _ moduleName ds (Just exts)) env = intercalate "\n" . execWriter $ do-  tell [ "module " ++ runModuleName moduleName ++ " where"]+  let exps = listExports exts+  tell ["module " ++ runModuleName moduleName ++ (if null exps then "" else " (" ++ exps ++ ")") ++ " where"]   mapM_ declToPs ds   mapM_ exportToPs exts   where +    listExports :: [DeclarationRef] -> String+    listExports = intercalate ", " . mapMaybe listExport++    listExport :: DeclarationRef -> Maybe String+    listExport (PositionedDeclarationRef _ _ d) = listExport d+    listExport (TypeRef name Nothing) = Just $ show name ++ "()"+    listExport (TypeRef name (Just dctors)) = Just $ show name ++ "(" ++ intercalate ", " (map show dctors) ++ ")"+    listExport (ValueRef name) = Just $ show name+    listExport (TypeClassRef name) = Just $ show name+    listExport (ModuleRef name) = Just $ "module " ++ show name+    listExport _ = Nothing+     declToPs :: Declaration -> Writer [String] ()     declToPs (ImportDeclaration mn _ _) = tell ["import " ++ show mn ++ " ()"]     declToPs (FixityDeclaration (Fixity assoc prec) op) =@@ -54,7 +67,7 @@       exportsOp (PositionedDeclarationRef _ _ r) = exportsOp r       exportsOp (ValueRef ident') = ident' == Op op       exportsOp _ = False-    declToPs (PositionedDeclaration _ com d) = mapM commentToPs com >> declToPs d+    declToPs (PositionedDeclaration _ com d) = mapM_ commentToPs com >> declToPs d     declToPs _ = return ()      commentToPs :: Comment -> Writer [String] ()@@ -63,7 +76,7 @@      exportToPs :: DeclarationRef -> Writer [String] ()     exportToPs (PositionedDeclarationRef _ _ r) = exportToPs r-    exportToPs (TypeRef pn dctors) = do+    exportToPs (TypeRef pn dctors) =       case Qualified (Just moduleName) pn `M.lookup` types env of         Nothing -> error $ show pn ++ " has no kind in exportToPs"         Just (kind, ExternData) ->@@ -90,7 +103,7 @@     exportToPs (ValueRef ident) =       case (moduleName, ident) `M.lookup` names env of         Nothing -> error $ show ident ++ " has no type in exportToPs"-        Just (ty, nameKind, _) | nameKind == Value || nameKind == Extern ForeignImport || nameKind == Extern InlineJavascript ->+        Just (ty, nk, _) | nk == Public || nk == External ->           tell ["foreign import " ++ show ident ++ " :: " ++ prettyPrintType ty]         _ -> return ()     exportToPs (TypeClassRef className) =@@ -107,11 +120,13 @@      exportToPs (TypeInstanceRef ident) = do       let TypeClassDictionaryInScope { tcdClassName = className, tcdInstanceTypes = tys, tcdDependencies = deps} =-            fromMaybe (error $ "Type class instance has no dictionary in exportToPs") . find (\tcd -> tcdName tcd == Qualified (Just moduleName) ident && tcdType tcd == TCDRegular) $ M.elems $ typeClassDictionaries env+            fromMaybe (error $ "Type class instance has no dictionary in exportToPs") . find (\tcd -> tcdName tcd == Qualified (Just moduleName) ident && tcdType tcd == TCDRegular) . maybe [] (M.elems >=> M.elems) . M.lookup (Just moduleName) $ typeClassDictionaries env       let constraintsText = case fromMaybe [] deps of                               [] -> ""                               cs -> "(" ++ intercalate ", " (map (\(pn, tys') -> show pn ++ " " ++ unwords (map prettyPrintTypeAtom tys')) cs) ++ ") => "       tell ["foreign import instance " ++ show ident ++ " :: " ++ constraintsText ++ show className ++ " " ++ unwords (map prettyPrintTypeAtom tys)]++    exportToPs (ModuleRef _) = return ()      toTypeVar :: (String, Maybe Kind) -> Type     toTypeVar (s, Nothing) = TypeVar s

src/Language/PureScript/CodeGen/JS.hs view

@@ -18,22 +18,23 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} -module Language.PureScript.CodeGen.JS (-    module AST,-    module Common,-    moduleToJs-) where+module Language.PureScript.CodeGen.JS+  ( module AST+  , module Common+  , moduleToJs+  , mainCall+  ) where -import Data.List ((\\), delete)-import Data.Maybe (mapMaybe)+import Data.List ((\\), delete, intersect) import qualified Data.Traversable as T (traverse)  import Control.Applicative import Control.Arrow ((&&&))-import Control.Monad (foldM, replicateM, forM)+import Control.Monad (replicateM, forM) import Control.Monad.Reader (MonadReader, asks) import Control.Monad.Supply.Class +import Language.PureScript.AST.SourcePos import Language.PureScript.CodeGen.JS.AST as AST import Language.PureScript.CodeGen.JS.Common as Common import Language.PureScript.CoreFn@@ -43,33 +44,28 @@ import Language.PureScript.Traversals (sndM) import qualified Language.PureScript.Constants as C +import System.FilePath.Posix ((</>))+ -- | -- Generate code in the simplified Javascript intermediate representation for all declarations in a -- module. ---moduleToJs :: forall m mode. (Applicative m, Monad m, MonadReader (Options mode) m, MonadSupply m)-           => Module Ann -> m [JS]-moduleToJs (Module coms mn imps exps foreigns decls) = do-  additional <- asks optionsAdditional+moduleToJs :: forall m. (Applicative m, Monad m, MonadReader Options m, MonadSupply m)+           => Module Ann -> Maybe JS -> m [JS]+moduleToJs (Module coms mn imps exps foreigns decls) foreign = do   jsImports <- T.traverse importToJs . delete (ModuleName [ProperName C.prim]) . (\\ [mn]) $ imps-  let foreigns' = mapMaybe (\(_, js, _) -> js) foreigns   jsDecls <- mapM bindToJs decls   optimized <- T.traverse (T.traverse optimize) jsDecls-  let isModuleEmpty = null exps   comments <- not <$> asks optionsNoComments   let strict = JSStringLiteral "use strict"   let header = if comments && not (null coms) then JSComment coms strict else strict-  let moduleBody = header : jsImports ++ foreigns' ++ concat optimized-  let exps' = JSObjectLiteral $ map (runIdent &&& JSVar . identToJs) exps-  return $ case additional of-    MakeOptions -> moduleBody ++ [JSAssignment (JSAccessor "exports" (JSVar "module")) exps']-    CompileOptions ns _ _ | not isModuleEmpty ->-      [ JSVariableIntroduction ns-                               (Just (JSBinary Or (JSVar ns) (JSObjectLiteral [])) )-      , JSAssignment (JSAccessor (moduleNameToJs mn) (JSVar ns))-                     (JSApp (JSFunction Nothing [] (JSBlock (moduleBody ++ [JSReturn exps']))) [])-      ]-    _ -> []+  let foreign' = [JSVariableIntroduction "$foreign" foreign | not $ null foreigns || foreign == Nothing]+  let moduleBody = header : foreign' ++ jsImports ++ concat optimized+  let foreignExps = exps `intersect` (fst `map` foreigns)+  let standardExps = exps \\ foreignExps+  let exps' = JSObjectLiteral $ map (runIdent &&& JSVar . identToJs) standardExps+                             ++ map (runIdent &&& foreignIdent) foreignExps+  return $ moduleBody ++ [JSAssignment (JSAccessor "exports" (JSVar "module")) exps']    where @@ -78,10 +74,8 @@   --   importToJs :: ModuleName -> m JS   importToJs mn' = do-    additional <- asks optionsAdditional-    let moduleBody = case additional of-          MakeOptions -> JSApp (JSVar "require") [JSStringLiteral (runModuleName mn')]-          CompileOptions ns _ _ -> JSAccessor (moduleNameToJs mn') (JSVar ns)+    path <- asks optionsRequirePath+    let moduleBody = JSApp (JSVar "require") [JSStringLiteral (maybe id (</>) path $ runModuleName mn')]     return $ JSVariableIntroduction (moduleNameToJs mn') (Just moduleBody)    -- |@@ -170,11 +164,17 @@     unApp :: Expr Ann -> [Expr Ann] -> (Expr Ann, [Expr Ann])     unApp (App _ val arg) args = unApp val (arg : args)     unApp other args = (other, args)+  valueToJs (Var (_, _, _, Just IsForeign) qi@(Qualified (Just mn') ident)) =+    return $ if mn' == mn+             then foreignIdent ident+             else varToJs qi+  valueToJs (Var (_, _, _, Just IsForeign) ident) =+    error $ "Encountered an unqualified reference to a foreign ident " ++ show ident   valueToJs (Var _ ident) =     return $ varToJs ident-  valueToJs (Case _ values binders) = do+  valueToJs (Case (maybeSpan, _, _, _) values binders) = do     vals <- mapM valueToJs values-    bindersToJs binders vals+    bindersToJs maybeSpan binders vals   valueToJs (Let _ ds val) = do     ds' <- concat <$> mapM bindToJs ds     ret <- valueToJs val@@ -205,6 +205,7 @@   literalToValueJS :: Literal (Expr Ann) -> m JS   literalToValueJS (NumericLiteral n) = return $ JSNumericLiteral n   literalToValueJS (StringLiteral s) = return $ JSStringLiteral s+  literalToValueJS (CharLiteral c) = return $ JSStringLiteral [c]   literalToValueJS (BooleanLiteral b) = return $ JSBooleanLiteral b   literalToValueJS (ArrayLiteral xs) = JSArrayLiteral <$> mapM valueToJs xs   literalToValueJS (ObjectLiteral ps) = JSObjectLiteral <$> mapM (sndM valueToJs) ps@@ -245,18 +246,21 @@   qualifiedToJS f (Qualified (Just mn') a) | mn /= mn' = accessor (f a) (JSVar (moduleNameToJs mn'))   qualifiedToJS f (Qualified _ a) = JSVar $ identToJs (f a) +  foreignIdent :: Ident -> JS+  foreignIdent ident = accessorString (runIdent ident) (JSVar "$foreign")+   -- |   -- Generate code in the simplified Javascript intermediate representation for pattern match binders   -- and guards.   ---  bindersToJs :: [CaseAlternative Ann] -> [JS] -> m JS-  bindersToJs binders vals = do+  bindersToJs :: Maybe SourceSpan -> [CaseAlternative Ann] -> [JS] -> m JS+  bindersToJs maybeSpan binders vals = do     valNames <- replicateM (length vals) freshName     let assignments = zipWith JSVariableIntroduction valNames (map Just vals)     jss <- forM binders $ \(CaseAlternative bs result) -> do       ret <- guardsToJs result       go valNames ret bs-    return $ JSApp (JSFunction Nothing [] (JSBlock (assignments ++ concat jss ++ [JSThrow $ JSUnary JSNew $ JSApp (JSVar "Error") [JSStringLiteral "Failed pattern match"]])))+    return $ JSApp (JSFunction Nothing [] (JSBlock (assignments ++ concat jss ++ [JSThrow $ failedPatternError valNames])))                    []     where       go :: [String] -> [JS] -> [Binder Ann] -> m [JS]@@ -266,6 +270,18 @@         binderToJs v done'' b       go _ _ _ = error "Invalid arguments to bindersToJs" +      failedPatternError :: [String] -> JS+      failedPatternError names = JSUnary JSNew $ JSApp (JSVar "Error") [JSBinary Add (JSStringLiteral errorMessage) (JSArrayLiteral $ zipWith valueError names vals)]++      errorMessage :: String+      errorMessage = "Failed pattern match" ++ maybe "" ((" at " ++) . displaySourceSpan) maybeSpan ++ ": "++      valueError :: String -> JS -> JS+      valueError _ l@(JSNumericLiteral _) = l+      valueError _ l@(JSStringLiteral _)  = l+      valueError _ l@(JSBooleanLiteral _) = l+      valueError s _                      = JSAccessor "name" . JSAccessor "constructor" $ JSVar s+       guardsToJs :: Either [(Guard Ann, Expr Ann)] (Expr Ann) -> m [JS]       guardsToJs (Left gs) = forM gs $ \(cond, val) -> do         cond' <- valueToJs cond@@ -301,23 +317,6 @@       done'' <- go remain done'       js <- binderToJs argVar done'' binder       return (JSVariableIntroduction argVar (Just (JSAccessor (identToJs field) (JSVar varName))) : js)-  binderToJs varName done binder@(ConstructorBinder _ _ ctor _) | isCons ctor = do-    let (headBinders, tailBinder) = uncons [] binder-        numberOfHeadBinders = fromIntegral $ length headBinders-    js1 <- foldM (\done' (headBinder, index) -> do-      headVar <- freshName-      jss <- binderToJs headVar done' headBinder-      return (JSVariableIntroduction headVar (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar varName))) : jss)) done (zip headBinders [0..])-    tailVar <- freshName-    js2 <- binderToJs tailVar js1 tailBinder-    return [JSIfElse (JSBinary GreaterThanOrEqualTo (JSAccessor "length" (JSVar varName)) (JSNumericLiteral (Left numberOfHeadBinders))) (JSBlock-      ( JSVariableIntroduction tailVar (Just (JSApp (JSAccessor "slice" (JSVar varName)) [JSNumericLiteral (Left numberOfHeadBinders)])) :-        js2-      )) Nothing]-    where-    uncons :: [Binder Ann] -> Binder Ann -> ([Binder Ann], Binder Ann)-    uncons acc (ConstructorBinder _ _ ctor' [h, t]) | isCons ctor' = uncons (h : acc) t-    uncons acc tailBinder = (reverse acc, tailBinder)   binderToJs _ _ b@(ConstructorBinder{}) =     error $ "Invalid ConstructorBinder in binderToJs: " ++ show b   binderToJs varName done (NamedBinder _ ident binder) = do@@ -327,6 +326,8 @@   literalToBinderJS :: String -> [JS] -> Literal (Binder Ann) -> m [JS]   literalToBinderJS varName done (NumericLiteral num) =     return [JSIfElse (JSBinary EqualTo (JSVar varName) (JSNumericLiteral num)) (JSBlock done) Nothing]+  literalToBinderJS varName done (CharLiteral c) =+    return [JSIfElse (JSBinary EqualTo (JSVar varName) (JSStringLiteral [c])) (JSBlock done) Nothing]   literalToBinderJS varName done (StringLiteral str) =     return [JSIfElse (JSBinary EqualTo (JSVar varName) (JSStringLiteral str)) (JSBlock done) Nothing]   literalToBinderJS varName done (BooleanLiteral True) =@@ -354,6 +355,5 @@       js <- binderToJs elVar done'' binder       return (JSVariableIntroduction elVar (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar varName))) : js) -  isCons :: Qualified ProperName -> Bool-  isCons (Qualified (Just mn') ctor) = mn' == ModuleName [ProperName C.prim] && ctor == ProperName "Array"-  isCons name = error $ "Unexpected argument in isCons: " ++ show name+mainCall :: ModuleName -> String -> JS+mainCall mmi ns = JSApp (JSAccessor C.main (JSAccessor (moduleNameToJs mmi) (JSVar ns))) []

src/Language/PureScript/CodeGen/JS/AST.hs view

@@ -17,7 +17,10 @@  module Language.PureScript.CodeGen.JS.AST where +import Control.Applicative (Applicative, (<$>), (<*>))+import Control.Monad.Identity import Data.Data+import Data.Traversable (traverse)  import Language.PureScript.Comments @@ -281,31 +284,34 @@   go other = f other  everywhereOnJSTopDown :: (JS -> JS) -> JS -> JS-everywhereOnJSTopDown f = go . f+everywhereOnJSTopDown f = runIdentity . everywhereOnJSTopDownM (Identity . f)++everywhereOnJSTopDownM :: (Applicative m, Monad m) => (JS -> m JS) -> JS -> m JS+everywhereOnJSTopDownM f = f >=> go   where-  go :: JS -> JS-  go (JSUnary op j) = JSUnary op (go (f j))-  go (JSBinary op j1 j2) = JSBinary op (go (f j1)) (go (f j2))-  go (JSArrayLiteral js) = JSArrayLiteral (map (go . f) js)-  go (JSIndexer j1 j2) = JSIndexer (go (f j1)) (go (f j2))-  go (JSObjectLiteral js) = JSObjectLiteral (map (fmap (go . f)) js)-  go (JSAccessor prop j) = JSAccessor prop (go (f j))-  go (JSFunction name args j) = JSFunction name args (go (f j))-  go (JSApp j js) = JSApp (go (f j)) (map (go . f) js)-  go (JSConditional j1 j2 j3) = JSConditional (go (f j1)) (go (f j2)) (go (f j3))-  go (JSBlock js) = JSBlock (map (go . f) js)-  go (JSVariableIntroduction name j) = JSVariableIntroduction name (fmap (go . f) j)-  go (JSAssignment j1 j2) = JSAssignment (go (f j1)) (go (f j2))-  go (JSWhile j1 j2) = JSWhile (go (f j1)) (go (f j2))-  go (JSFor name j1 j2 j3) = JSFor name (go (f j1)) (go (f j2)) (go (f j3))-  go (JSForIn name j1 j2) = JSForIn name (go (f j1)) (go (f j2))-  go (JSIfElse j1 j2 j3) = JSIfElse (go (f j1)) (go (f j2)) (fmap (go . f) j3)-  go (JSReturn j) = JSReturn (go (f j))-  go (JSThrow j) = JSThrow (go (f j))-  go (JSTypeOf j) = JSTypeOf (go (f j))-  go (JSLabel name j) = JSLabel name (go (f j))-  go (JSInstanceOf j1 j2) = JSInstanceOf (go (f j1)) (go (f j2))-  go (JSComment com j) = JSComment com (go (f j))+  f' = f >=> go+  go (JSUnary op j) = JSUnary op <$> f' j+  go (JSBinary op j1 j2) = JSBinary op <$> f' j1 <*> f' j2+  go (JSArrayLiteral js) = JSArrayLiteral <$> traverse f' js+  go (JSIndexer j1 j2) = JSIndexer <$> f' j1 <*> f' j2+  go (JSObjectLiteral js) = JSObjectLiteral <$> traverse (traverse f') js+  go (JSAccessor prop j) = JSAccessor prop <$> f' j+  go (JSFunction name args j) = JSFunction name args <$> f' j+  go (JSApp j js) = JSApp <$> f' j <*> traverse f' js+  go (JSConditional j1 j2 j3) = JSConditional <$> f' j1 <*> f' j2 <*> f' j3+  go (JSBlock js) = JSBlock <$> traverse f' js+  go (JSVariableIntroduction name j) = JSVariableIntroduction name <$> traverse f' j+  go (JSAssignment j1 j2) = JSAssignment <$> f' j1 <*> f' j2+  go (JSWhile j1 j2) = JSWhile <$> f' j1 <*> f' j2+  go (JSFor name j1 j2 j3) = JSFor name <$> f' j1 <*> f' j2 <*> f' j3+  go (JSForIn name j1 j2) = JSForIn name <$> f' j1 <*> f' j2+  go (JSIfElse j1 j2 j3) = JSIfElse <$> f' j1 <*> f' j2 <*> traverse f' j3+  go (JSReturn j) = JSReturn <$> f' j+  go (JSThrow j) = JSThrow <$> f' j+  go (JSTypeOf j) = JSTypeOf <$> f' j+  go (JSLabel name j) = JSLabel name <$> f' j+  go (JSInstanceOf j1 j2) = JSInstanceOf <$> f' j1 <*> f' j2+  go (JSComment com j) = JSComment com <$> f' j   go other = f other  everythingOnJS :: (r -> r -> r) -> (JS -> r) -> JS -> r

src/Language/PureScript/CodeGen/JS/Optimizer.hs view

@@ -37,7 +37,9 @@     optimize ) where +import Control.Applicative (Applicative) import Control.Monad.Reader (MonadReader, ask, asks)+import Control.Monad.Supply.Class (MonadSupply)  import Language.PureScript.CodeGen.JS.AST import Language.PureScript.Options@@ -53,15 +55,15 @@ -- | -- Apply a series of optimizer passes to simplified Javascript code ---optimize :: (Monad m, MonadReader (Options mode) m) => JS -> m JS+optimize :: (Monad m, MonadReader Options m, Applicative m, MonadSupply m) => JS -> m JS optimize js = do   noOpt <- asks optionsNoOptimizations   if noOpt then return js else optimize' js -optimize' :: (Monad m, MonadReader (Options mode) m) => JS -> m JS+optimize' :: (Monad m, MonadReader Options m, Applicative m, MonadSupply m) => JS -> m JS optimize' js = do   opts <- ask-  return $ untilFixedPoint (applyAll+  untilFixedPoint (inlineArrComposition . applyAll     [ collapseNestedBlocks     , collapseNestedIfs     , tco opts@@ -76,11 +78,12 @@     , inlineValues     , inlineOperator (C.prelude, (C.$)) $ \f x -> JSApp f [x]     , inlineOperator (C.prelude, (C.#)) $ \x f -> JSApp f [x]-    , inlineOperator (C.preludeUnsafe, C.unsafeIndex) $ flip JSIndexer+    , inlineOperator (C.dataArrayUnsafe, C.unsafeIndex) $ flip JSIndexer     , inlineCommonOperators ]) js -untilFixedPoint :: (Eq a) => (a -> a) -> a -> a+untilFixedPoint :: (Monad m, Eq a) => (a -> m a) -> a -> m a untilFixedPoint f = go   where-  go a = let a' = f a in-          if a' == a then a' else go a'+  go a = do+   a' <- f a+   if a' == a then return a' else go a'

src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs view

@@ -18,11 +18,14 @@   inlineValues,   inlineOperator,   inlineCommonOperators,+  inlineArrComposition,   etaConvert,   unThunk,   evaluateIifes ) where +import Control.Applicative (Applicative)+import Control.Monad.Supply.Class (MonadSupply, freshName) import Data.Maybe (fromMaybe)  import Language.PureScript.CodeGen.JS.AST@@ -31,6 +34,10 @@ import Language.PureScript.CodeGen.JS.Optimizer.Common import qualified Language.PureScript.Constants as C +-- TODO: Potential bug:+-- Shouldn't just inline this case: { var x = 0; x.toFixed(10); }+-- Needs to be: { 0..toFixed(10); }+-- Probably needs to be fixed in pretty-printer instead. shouldInline :: JS -> Bool shouldInline (JSVar _) = True shouldInline (JSNumericLiteral _) = True@@ -84,10 +91,26 @@ inlineValues = everywhereOnJS convert   where   convert :: JS -> JS-  convert (JSApp fn [dict]) | isPreludeDict C.semiringNumber dict && isPreludeFn C.zero fn = JSNumericLiteral (Left 0)-  convert (JSApp fn [dict]) | isPreludeDict C.semiringNumber dict && isPreludeFn C.one fn = JSNumericLiteral (Left 1)-  convert (JSApp (JSApp fn [x]) [y]) | isPreludeFn (C.%) fn = JSBinary Modulus x y+  convert (JSApp fn [dict]) | isDict semiringNumber dict && isFn fnZero fn = JSNumericLiteral (Left 0)+                            | isDict semiringNumber dict && isFn fnOne fn = JSNumericLiteral (Left 1)+                            | isDict semiringInt dict && isFn fnZero fn = JSNumericLiteral (Left 0)+                            | isDict semiringInt dict && isFn fnOne fn = JSNumericLiteral (Left 1)+                            | isDict boundedBoolean dict && isFn fnBottom fn = JSBooleanLiteral False+                            | isDict boundedBoolean dict && isFn fnTop fn = JSBooleanLiteral True+  convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y])+    | isDict semiringInt dict && isFn fnAdd fn = JSBinary BitwiseOr (JSBinary Add x y) (JSNumericLiteral (Left 0))+    | isDict semiringInt dict && isFn fnMultiply fn = JSBinary BitwiseOr (JSBinary Multiply x y) (JSNumericLiteral (Left 0))+    | isDict moduloSemiringInt dict && isFn fnDivide fn = JSBinary BitwiseOr (JSBinary Divide x y) (JSNumericLiteral (Left 0))+    | isDict ringInt dict && isFn fnSubtract fn = JSBinary BitwiseOr (JSBinary Subtract x y) (JSNumericLiteral (Left 0))   convert other = other+  fnZero = (C.prelude, C.zero)+  fnOne = (C.prelude, C.one)+  fnBottom = (C.prelude, C.bottom)+  fnTop = (C.prelude, C.top)+  fnAdd = (C.prelude, (C.+))+  fnDivide = (C.prelude, (C./))+  fnMultiply = (C.prelude, (C.*))+  fnSubtract = (C.prelude, (C.-))  inlineOperator :: (String, String) -> (JS -> JS -> JS) -> JS -> JS inlineOperator (m, op) f = everywhereOnJS convert@@ -101,59 +124,84 @@  inlineCommonOperators :: JS -> JS inlineCommonOperators = applyAll $-  [ binary C.semiringNumber (C.+) Add-  , binary C.semiringNumber (C.*) Multiply-  , binary C.ringNumber (C.-) Subtract-  , unary  C.ringNumber C.negate Negate-  , binary C.moduloSemiringNumber (C./) Divide+  [ binary semiringNumber (C.+) Add+  , binary semiringNumber (C.*) Multiply -  , binary C.ordNumber (C.<) LessThan-  , binary C.ordNumber (C.>) GreaterThan-  , binary C.ordNumber (C.<=) LessThanOrEqualTo-  , binary C.ordNumber (C.>=) GreaterThanOrEqualTo+  , binary ringNumber (C.-) Subtract+  , unary  ringNumber C.negate Negate+  , binary ringInt (C.-) Subtract+  , unary  ringInt C.negate Negate -  , binary C.eqNumber (C.==) EqualTo-  , binary C.eqNumber (C./=) NotEqualTo-  , binary C.eqString (C.==) EqualTo-  , binary C.eqString (C./=) NotEqualTo-  , binary C.eqBoolean (C.==) EqualTo-  , binary C.eqBoolean (C./=) NotEqualTo+  , binary moduloSemiringNumber (C./) Divide+  , binary moduloSemiringInt C.mod Modulus -  , binary C.semigroupString (C.<>) Add-  , binary C.semigroupString (C.++) Add+  , binary eqNumber (C.==) EqualTo+  , binary eqNumber (C./=) NotEqualTo+  , binary eqInt (C.==) EqualTo+  , binary eqInt (C./=) NotEqualTo+  , binary eqString (C.==) EqualTo+  , binary eqString (C./=) NotEqualTo+  , binary eqBoolean (C.==) EqualTo+  , binary eqBoolean (C./=) NotEqualTo -  , binaryFunction C.bitsNumber C.shl ShiftLeft-  , binaryFunction C.bitsNumber C.shr ShiftRight-  , binaryFunction C.bitsNumber C.zshr ZeroFillShiftRight-  , binary         C.bitsNumber (C..&.) BitwiseAnd-  , binary         C.bitsNumber (C..|.) BitwiseOr-  , binary         C.bitsNumber (C..^.) BitwiseXor-  , unary          C.bitsNumber C.complement BitwiseNot+  , binary ordNumber (C.<) LessThan+  , binary ordNumber (C.>) GreaterThan+  , binary ordNumber (C.<=) LessThanOrEqualTo+  , binary ordNumber (C.>=) GreaterThanOrEqualTo+  , binary ordInt (C.<) LessThan+  , binary ordInt (C.>) GreaterThan+  , binary ordInt (C.<=) LessThanOrEqualTo+  , binary ordInt (C.>=) GreaterThanOrEqualTo -  , binary C.boolLikeBoolean (C.&&) And-  , binary C.boolLikeBoolean (C.||) Or-  , unary  C.boolLikeBoolean C.not Not+  , binary semigroupString (C.<>) Add+  , binary semigroupString (C.++) Add++  , binary latticeBoolean (C.&&) And+  , binary latticeBoolean (C.||) Or+  , binaryFunction latticeBoolean C.inf And+  , binaryFunction latticeBoolean C.sup Or+  , unary complementedLatticeBoolean C.not Not++  , binary' C.dataIntBits (C..|.) BitwiseOr+  , binary' C.dataIntBits (C..&.) BitwiseAnd+  , binary' C.dataIntBits (C..^.) BitwiseXor+  , binary' C.dataIntBits C.shl ShiftLeft+  , binary' C.dataIntBits C.shr ShiftRight+  , binary' C.dataIntBits C.zshr ZeroFillShiftRight+  , unary'  C.dataIntBits C.complement BitwiseNot   ] ++   [ fn | i <- [0..10], fn <- [ mkFn i, runFn i ] ]   where-  binary :: String -> String -> BinaryOperator -> JS -> JS-  binary dictName opString op = everywhereOnJS convert+  binary :: (String, String) -> String -> BinaryOperator -> JS -> JS+  binary dict opString op = everywhereOnJS convert     where     convert :: JS -> JS-    convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isPreludeDict dictName dict && isPreludeFn opString fn = JSBinary op x y+    convert (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) | isDict dict dict' && isPreludeFn opString fn = JSBinary op x y     convert other = other-  binaryFunction :: String -> String -> BinaryOperator -> JS -> JS-  binaryFunction dictName fnName op = everywhereOnJS convert+  binary' :: String -> String -> BinaryOperator -> JS -> JS+  binary' moduleName opString op = everywhereOnJS convert     where     convert :: JS -> JS-    convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isPreludeFn fnName fn && isPreludeDict dictName dict = JSBinary op x y+    convert (JSApp (JSApp fn [x]) [y]) | isFn (moduleName, opString) fn = JSBinary op x y     convert other = other-  unary :: String -> String -> UnaryOperator -> JS -> JS-  unary dictName fnName op = everywhereOnJS convert+  binaryFunction :: (String, String) -> String -> BinaryOperator -> JS -> JS+  binaryFunction dict fnName op = everywhereOnJS convert     where     convert :: JS -> JS-    convert (JSApp (JSApp fn [dict]) [x]) | isPreludeFn fnName fn && isPreludeDict dictName dict = JSUnary op x+    convert (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) | isPreludeFn fnName fn && isDict dict dict' = JSBinary op x y     convert other = other+  unary :: (String, String) -> String -> UnaryOperator -> JS -> JS+  unary dict fnName op = everywhereOnJS convert+    where+    convert :: JS -> JS+    convert (JSApp (JSApp fn [dict']) [x]) | isPreludeFn fnName fn && isDict dict dict' = JSUnary op x+    convert other = other+  unary' :: String -> String -> UnaryOperator -> JS -> JS+  unary' moduleName fnName op = everywhereOnJS convert+    where+    convert :: JS -> JS+    convert (JSApp fn [x]) | isFn (moduleName, fnName) fn = JSUnary op x+    convert other = other   mkFn :: Int -> JS -> JS   mkFn 0 = everywhereOnJS convert     where@@ -190,12 +238,80 @@     go m acc (JSApp lhs [arg]) = go (m - 1) (arg : acc) lhs     go _ _   _ = Nothing -isPreludeDict :: String -> JS -> Bool-isPreludeDict dictName (JSAccessor prop (JSVar prelude)) = prelude == C.prelude && prop == dictName-isPreludeDict _ _ = False+-- (f <<< g $ x) = f (g x)+-- (f <<< g)     = \x -> f (g x)+inlineArrComposition :: (Applicative m, MonadSupply m) => JS -> m JS+inlineArrComposition = everywhereOnJSTopDownM convert+  where+  convert :: (MonadSupply m) => JS -> m JS+  convert (JSApp (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) [z]) | isArrCompose dict' fn =+    return $ JSApp x [JSApp y [z]]+  convert (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) | isArrCompose dict' fn = do+    arg <- freshName+    return $ JSFunction Nothing [arg] (JSBlock [JSReturn $ JSApp x [JSApp y [JSVar arg]]])+  convert other = return other+  isArrCompose :: JS -> JS -> Bool+  isArrCompose dict' fn = isDict semigroupoidArr dict' && isPreludeFn (C.<<<) fn +isDict :: (String, String) -> JS -> Bool+isDict (moduleName, dictName) (JSAccessor x (JSVar y)) = x == dictName && y == moduleName+isDict _ _ = False++isFn :: (String, String) -> JS -> Bool+isFn (moduleName, fnName) (JSAccessor x (JSVar y)) = x == fnName && y == moduleName+isFn (moduleName, fnName) (JSIndexer (JSStringLiteral x) (JSVar y)) = x == fnName && y == moduleName+isFn _ _ = False+ isPreludeFn :: String -> JS -> Bool-isPreludeFn fnName (JSAccessor fnName' (JSVar prelude)) = prelude == C.prelude && fnName' == fnName-isPreludeFn fnName (JSIndexer (JSStringLiteral fnName') (JSVar prelude)) = prelude == C.prelude && fnName' == fnName-isPreludeFn fnName (JSAccessor longForm (JSAccessor prelude (JSVar _))) = prelude == C.prelude && longForm == identToJs (Op fnName)-isPreludeFn _ _ = False+isPreludeFn fnName = isFn (C.prelude, fnName)++semiringNumber :: (String, String)+semiringNumber = (C.prelude, C.semiringNumber)++semiringInt :: (String, String)+semiringInt = (C.dataInt, C.semiringInt)++ringNumber :: (String, String)+ringNumber = (C.prelude, C.ringNumber)++ringInt :: (String, String)+ringInt = (C.dataInt, C.ringInt)++moduloSemiringNumber :: (String, String)+moduloSemiringNumber = (C.prelude, C.moduloSemiringNumber)++moduloSemiringInt :: (String, String)+moduloSemiringInt = (C.dataInt, C.moduloSemiringInt)++eqNumber :: (String, String)+eqNumber = (C.prelude, C.eqNumber)++eqInt :: (String, String)+eqInt = (C.dataInt, C.eqInt)++eqString :: (String, String)+eqString = (C.prelude, C.eqNumber)++eqBoolean :: (String, String)+eqBoolean = (C.prelude, C.eqNumber)++ordNumber :: (String, String)+ordNumber = (C.prelude, C.ordNumber)++ordInt :: (String, String)+ordInt = (C.dataInt, C.ordInt)++semigroupString :: (String, String)+semigroupString = (C.prelude, C.semigroupString)++boundedBoolean :: (String, String)+boundedBoolean = (C.prelude, C.boundedBoolean)++latticeBoolean :: (String, String)+latticeBoolean = (C.prelude, C.latticeBoolean)++complementedLatticeBoolean :: (String, String)+complementedLatticeBoolean = (C.prelude, C.complementedLatticeBoolean)++semigroupoidArr :: (String, String)+semigroupoidArr = (C.prelude, C.semigroupoidArr)

src/Language/PureScript/CodeGen/JS/Optimizer/MagicDo.hs view

@@ -27,7 +27,7 @@ import Language.PureScript.Options import qualified Language.PureScript.Constants as C -magicDo :: Options mode -> JS -> JS+magicDo :: Options -> JS -> JS magicDo opts | optionsNoMagicDo opts = id              | otherwise = inlineST . magicDo' @@ -81,8 +81,8 @@   isPure (JSApp purePoly [effDict]) | isPurePoly purePoly && isEffDict C.applicativeEffDictionary effDict = True   isPure _ = False   -- Check if an expression represents the polymorphic >>= function-  isBindPoly (JSAccessor prop (JSVar prelude)) = prelude == C.prelude && prop == identToJs (Op (C.>>=))-  isBindPoly (JSIndexer (JSStringLiteral bind) (JSVar prelude)) = prelude == C.prelude && bind == (C.>>=)+  isBindPoly (JSAccessor prop (JSVar prelude)) = prelude == C.prelude && (prop `elem` map identToJs [Ident C.bind, Op (C.>>=)])+  isBindPoly (JSIndexer (JSStringLiteral bind) (JSVar prelude)) = prelude == C.prelude && (bind `elem` [C.bind, (C.>>=)])   isBindPoly _ = False   -- Check if an expression represents the polymorphic return function   isRetPoly (JSAccessor returnEscaped (JSVar prelude)) = prelude == C.prelude && returnEscaped == C.returnEscaped

src/Language/PureScript/CodeGen/JS/Optimizer/TCO.hs view

@@ -15,13 +15,15 @@  module Language.PureScript.CodeGen.JS.Optimizer.TCO (tco) where +import Data.Monoid+ import Language.PureScript.Options import Language.PureScript.CodeGen.JS.AST  -- | -- Eliminate tail calls ---tco :: Options mode -> JS -> JS+tco :: Options -> JS -> JS tco opts | optionsNoTco opts = id          | otherwise = tco' @@ -30,10 +32,13 @@   where   tcoLabel :: String   tcoLabel = "tco"+   tcoVar :: String -> String   tcoVar arg = "__tco_" ++ arg+   copyVar :: String -> String   copyVar arg = "__copy_" ++ arg+   convert :: JS -> JS   convert js@(JSVariableIntroduction name (Just fn@JSFunction {})) =     let@@ -46,6 +51,7 @@               JSVariableIntroduction name (Just (replace (toLoop name allArgs body')))         | otherwise -> js   convert js = js+   collectAllFunctionArgs :: [[String]] -> (JS -> JS) -> JS -> ([[String]], JS, JS -> JS)   collectAllFunctionArgs allArgs f (JSFunction ident args (JSBlock (body@(JSReturn _):_))) =     collectAllFunctionArgs (args : allArgs) (\b -> f (JSFunction ident (map copyVar args) (JSBlock [b]))) body@@ -56,25 +62,35 @@   collectAllFunctionArgs allArgs f (JSReturn (JSFunction ident args body@(JSBlock _))) =     (args : allArgs, body, f . JSReturn . JSFunction ident (map copyVar args))   collectAllFunctionArgs allArgs f body = (allArgs, body, f)+   isTailCall :: String -> JS -> Bool   isTailCall ident js =     let       numSelfCalls = everythingOnJS (+) countSelfCalls js       numSelfCallsInTailPosition = everythingOnJS (+) countSelfCallsInTailPosition js       numSelfCallsUnderFunctions = everythingOnJS (+) countSelfCallsUnderFunctions js+      numSelfCallWithFnArgs = everythingOnJS (+) countSelfCallsWithFnArgs js     in       numSelfCalls > 0       && numSelfCalls == numSelfCallsInTailPosition       && numSelfCallsUnderFunctions == 0+      && numSelfCallWithFnArgs == 0     where     countSelfCalls :: JS -> Int     countSelfCalls (JSApp (JSVar ident') _) | ident == ident' = 1     countSelfCalls _ = 0+         countSelfCallsInTailPosition :: JS -> Int     countSelfCallsInTailPosition (JSReturn ret) | isSelfCall ident ret = 1     countSelfCallsInTailPosition _ = 0+    +    countSelfCallsUnderFunctions :: JS -> Int     countSelfCallsUnderFunctions (JSFunction _ _ js') = everythingOnJS (+) countSelfCalls js'     countSelfCallsUnderFunctions _ = 0+    +    countSelfCallsWithFnArgs :: JS -> Int+    countSelfCallsWithFnArgs ret = if isSelfCallWithFnArgs ident ret [] then 1 else 0+   toLoop :: String -> [String] -> JS -> JS   toLoop ident allArgs js = JSBlock $         map (\arg -> JSVariableIntroduction arg (Just (JSVar (copyVar arg)))) allArgs ++@@ -94,10 +110,19 @@     collectSelfCallArgs :: [[JS]] -> JS -> [[JS]]     collectSelfCallArgs allArgumentValues (JSApp fn args') = collectSelfCallArgs (args' : allArgumentValues) fn     collectSelfCallArgs allArgumentValues _ = allArgumentValues+   isSelfCall :: String -> JS -> Bool-  isSelfCall ident (JSApp (JSVar ident') args) | ident == ident' && not (any isFunction args) = True-  isSelfCall ident (JSApp fn args) | not (any isFunction args) = isSelfCall ident fn+  isSelfCall ident (JSApp (JSVar ident') _) = ident == ident'+  isSelfCall ident (JSApp fn _) = isSelfCall ident fn   isSelfCall _ _ = False-  isFunction :: JS -> Bool-  isFunction (JSFunction _ _ _) = True-  isFunction _ = False++  isSelfCallWithFnArgs :: String -> JS -> [JS] -> Bool+  isSelfCallWithFnArgs ident (JSVar ident') args | ident == ident' && any hasFunction args = True+  isSelfCallWithFnArgs ident (JSApp fn args) acc = isSelfCallWithFnArgs ident fn (args ++ acc)+  isSelfCallWithFnArgs _ _ _ = False+    +  hasFunction :: JS -> Bool +  hasFunction = getAny . everythingOnJS mappend (Any . isFunction)+    where+    isFunction (JSFunction _ _ _) = True+    isFunction _ = False

src/Language/PureScript/Constants.hs view

@@ -15,7 +15,7 @@  module Language.PureScript.Constants where --- Prelude Operators+-- Operators  ($) :: String ($) = "$"@@ -65,29 +65,47 @@ (/=) :: String (/=) = "/=" -(.&.) :: String-(.&.) = ".&."--(.|.) :: String-(.|.) = ".|."--(.^.) :: String-(.^.) = ".^."- (&&) :: String (&&) = "&&"  (||) :: String (||) = "||" +bind :: String+bind = "bind"+ unsafeIndex :: String unsafeIndex = "unsafeIndex" --- Prelude Operator Functions+(.|.) :: String+(.|.) = ".|." +(.&.) :: String+(.&.) = ".&."++(.^.) :: String+(.^.) = ".^."++(<<<) :: String+(<<<) = "<<<"++-- Functions+ negate :: String negate = "negate" +not :: String+not = "not"++sup :: String+sup = "sup"++inf :: String+inf = "inf"++mod :: String+mod = "mod"+ shl :: String shl = "shl" @@ -100,9 +118,6 @@ complement :: String complement = "complement" -not :: String-not = "not"- -- Prelude Values  zero :: String@@ -111,6 +126,12 @@ one :: String one = "one" +bottom :: String+bottom = "bottom"++top :: String+top = "top"+ return :: String return = "return" @@ -172,33 +193,48 @@ semiringNumber :: String semiringNumber = "semiringNumber" +semiringInt :: String+semiringInt = "semiringInt"+ ringNumber :: String ringNumber = "ringNumber" +ringInt :: String+ringInt = "ringInt"+ moduloSemiringNumber :: String moduloSemiringNumber = "moduloSemiringNumber" -numNumber :: String-numNumber = "numNumber"+moduloSemiringInt :: String+moduloSemiringInt = "moduloSemiringInt"  ordNumber :: String ordNumber = "ordNumber" +ordInt :: String+ordInt = "ordInt"+ eqNumber :: String eqNumber = "eqNumber" +eqInt :: String+eqInt = "eqInt"+ eqString :: String eqString = "eqString"  eqBoolean :: String eqBoolean = "eqBoolean" -bitsNumber :: String-bitsNumber = "bitsNumber"+boundedBoolean :: String+boundedBoolean = "boundedBoolean" -boolLikeBoolean :: String-boolLikeBoolean = "boolLikeBoolean"+latticeBoolean :: String+latticeBoolean = "latticeBoolean" +complementedLatticeBoolean :: String+complementedLatticeBoolean = "complementedLatticeBoolean"+ semigroupString :: String semigroupString = "semigroupString" @@ -226,8 +262,8 @@ prelude :: String prelude = "Prelude" -preludeUnsafe :: String-preludeUnsafe = "Prelude_Unsafe"+dataArrayUnsafe :: String+dataArrayUnsafe = "Data_Array_Unsafe"  eff :: String eff = "Control_Monad_Eff"@@ -237,3 +273,9 @@  dataFunction :: String dataFunction = "Data_Function"++dataInt :: String+dataInt = "Data_Int"++dataIntBits :: String+dataIntBits = "Data_Int_Bits"

src/Language/PureScript/CoreFn/Desugar.hs view

@@ -83,6 +83,8 @@     Literal (ss, com, ty, Nothing) (NumericLiteral v)   exprToCoreFn ss com ty (A.StringLiteral v) =     Literal (ss, com, ty, Nothing) (StringLiteral v)+  exprToCoreFn ss com ty (A.CharLiteral v) =+    Literal (ss, com, ty, Nothing) (CharLiteral v)   exprToCoreFn ss com ty (A.BooleanLiteral v) =     Literal (ss, com, ty, Nothing) (BooleanLiteral v)   exprToCoreFn ss com ty (A.ArrayLiteral vs) =@@ -100,7 +102,7 @@   exprToCoreFn ss com ty (A.App v1 v2) =     App (ss, com, ty, Nothing) (exprToCoreFn ss [] Nothing v1) (exprToCoreFn ss [] Nothing v2)   exprToCoreFn ss com ty (A.Var ident) =-    Var (ss, com, ty, Nothing) ident+    Var (ss, com, ty, getValueMeta ident) ident   exprToCoreFn ss com ty (A.IfThenElse v1 v2 v3) =     Case (ss, com, ty, Nothing) [exprToCoreFn ss [] Nothing v1]       [ CaseAlternative [LiteralBinder nullAnn $ BooleanLiteral True]@@ -147,6 +149,8 @@     LiteralBinder (ss, com, Nothing, Nothing) (BooleanLiteral b)   binderToCoreFn ss com (A.StringBinder s) =     LiteralBinder (ss, com, Nothing, Nothing) (StringLiteral s)+  binderToCoreFn ss com (A.CharBinder c) =+    LiteralBinder (ss, com, Nothing, Nothing) (CharLiteral c)   binderToCoreFn ss com (A.NumberBinder n) =     LiteralBinder (ss, com, Nothing, Nothing) (NumericLiteral n)   binderToCoreFn ss com (A.VarBinder name) =@@ -158,15 +162,21 @@     LiteralBinder (ss, com, Nothing, Nothing) (ObjectLiteral $ map (second (binderToCoreFn ss [])) bs)   binderToCoreFn ss com (A.ArrayBinder bs) =     LiteralBinder (ss, com, Nothing, Nothing) (ArrayLiteral $ map (binderToCoreFn ss []) bs)-  binderToCoreFn ss com (A.ConsBinder b1 b2) =-    let arrCtor = Qualified (Just $ ModuleName [ProperName "Prim"]) (ProperName "Array")-    in ConstructorBinder (ss, com, Nothing, Nothing) arrCtor arrCtor $ map (binderToCoreFn ss []) [b1, b2]   binderToCoreFn ss com (A.NamedBinder name b) =     NamedBinder (ss, com, Nothing, Nothing) name (binderToCoreFn ss [] b)   binderToCoreFn _ com (A.PositionedBinder ss com1 b) =     binderToCoreFn (Just ss) (com ++ com1) b    -- |+  -- Gets metadata for values.+  --+  getValueMeta :: Qualified Ident -> Maybe Meta+  getValueMeta name =+    case lookupValue env name of+      Just (_, External, _) -> Just IsForeign+      _ -> Nothing++  -- |   -- Gets metadata for data constructors.   --   getConstructorMeta :: Qualified ProperName -> Meta@@ -197,7 +207,7 @@   fqValues (A.Var (Qualified (Just mn) _)) = [mn]   fqValues (A.Constructor (Qualified (Just mn) _)) = [mn]   fqValues _ = []-  +   fqBinders :: A.Binder -> [ModuleName]   fqBinders (A.ConstructorBinder (Qualified (Just mn) _) _) = [mn]   fqBinders _ = []@@ -214,8 +224,8 @@ -- Desugars foreign declarations from AST to CoreFn representation. -- externToCoreFn :: A.Declaration -> Maybe ForeignDecl-externToCoreFn (A.ExternDeclaration _ name js ty) = Just (name, js, ty)-externToCoreFn (A.ExternInstanceDeclaration name _ _ _) = Just (name, Nothing, tyObject)+externToCoreFn (A.ExternDeclaration name ty) = Just (name, ty)+externToCoreFn (A.ExternInstanceDeclaration name _ _ _) = Just (name, tyObject) externToCoreFn (A.PositionedDeclaration _ _ d) = externToCoreFn d externToCoreFn _ = Nothing

src/Language/PureScript/CoreFn/Literals.hs view

@@ -33,6 +33,10 @@   --   | StringLiteral String   -- |+  -- A character literal+  --+  | CharLiteral Char+  -- |   -- A boolean literal   --   | BooleanLiteral Bool

src/Language/PureScript/CoreFn/Meta.hs view

@@ -35,7 +35,11 @@   -- |   -- The contained value is a typeclass dictionary constructor   ---  | IsTypeClassConstructor deriving (Show, D.Data, D.Typeable)+  | IsTypeClassConstructor+  -- |+  -- The contained reference is for a foreign member+  --+  | IsForeign deriving (Show, D.Data, D.Typeable)  -- | -- Data constructor metadata

src/Language/PureScript/CoreFn/Module.hs view

@@ -14,7 +14,6 @@  module Language.PureScript.CoreFn.Module where -import Language.PureScript.CodeGen.JS.AST import Language.PureScript.Comments import Language.PureScript.CoreFn.Expr import Language.PureScript.Names@@ -29,4 +28,4 @@   , moduleDecls :: [Bind a]   } deriving (Show) -type ForeignDecl = (Ident, Maybe JS, Type)+type ForeignDecl = (Ident, Type)

− src/Language/PureScript/DeadCodeElimination.hs

@@ -1,102 +0,0 @@------------------------------------------------------------------------------------ Module      :  Language.PureScript.DeadCodeElimination--- Copyright   :  (c) 2014 Phil Freeman--- License     :  MIT------ Maintainer  :  Phil Freeman <paf31@cantab.net>--- Stability   :  experimental--- Portability :------ | Dead code elimination.-----------------------------------------------------------------------------------module Language.PureScript.DeadCodeElimination (-  eliminateDeadCode-) where--import Data.Graph-import Data.List-import Data.Maybe (mapMaybe)--import Language.PureScript.CoreFn-import Language.PureScript.Names---- |--- Eliminate all declarations which are not a transitive dependency of the entry point module----eliminateDeadCode :: [ModuleName] -> [Module a] -> [Module a]-eliminateDeadCode entryPoints ms = map go ms-  where-  go (Module coms mn imps exps foreigns ds) = Module coms mn imps exps' foreigns' ds'-    where-    ds' = filter (isUsed mn graph vertexFor entryPointVertices) ds-    foreigns' = filter (isUsed' mn graph vertexFor entryPointVertices . foreignIdent) foreigns-    names = concatMap bindIdents ds' ++ map foreignIdent foreigns'-    exps' = filter (`elem` names) exps-  declarations = concatMap declarationsByModule ms-  (graph, _, vertexFor) = graphFromEdges $ map (\(key, deps) -> (key, key, deps)) declarations-  entryPointVertices = mapMaybe (vertexFor . fst) . filter (\((mn, _), _) -> mn `elem` entryPoints) $ declarations---- |--- Extract declaration names for a binding group.----bindIdents :: Bind a -> [Ident]-bindIdents (NonRec name _) = [name]-bindIdents (Rec names) = map fst names---- |--- Extract the ident for a foreign declaration.----foreignIdent :: ForeignDecl -> Ident-foreignIdent (name, _, _) = name---- |--- Key type to use in graph----type Key = (ModuleName, Ident)---- |--- Find dependencies for each member in a module.----declarationsByModule :: Module a -> [(Key, [Key])]-declarationsByModule (Module _ mn _ _ fs ds) =-  let fs' = map ((\name -> ((mn, name), [])) . foreignIdent) fs-  in fs' ++ concatMap go ds-  where-  go :: Bind a -> [(Key, [Key])]-  go d@(NonRec name _) = [((mn, name), dependencies d)]-  go d@(Rec names') = map (\(name, _) -> ((mn, name), dependencies d)) names'---- |--- Find all referenced values within a binding group.----dependencies :: Bind a -> [Key]-dependencies =-  let (f, _, _, _) = everythingOnValues (++) (const []) values binders (const [])-  in nub . f-  where-  values :: Expr a -> [Key]-  values (Var _ (Qualified (Just mn) ident)) = [(mn, ident)]-  values _ = []-  binders :: Binder a -> [Key]-  binders (ConstructorBinder _ _ (Qualified (Just mn) ident) _) = [(mn, Ident $ runProperName ident)]-  binders _ = []---- |--- Check whether a binding group is used.----isUsed :: ModuleName -> Graph -> (Key -> Maybe Vertex) -> [Vertex] -> Bind a -> Bool-isUsed mn graph vertexFor entryPointVertices (NonRec name _) =-  isUsed' mn graph vertexFor entryPointVertices name-isUsed mn graph vertexFor entryPointVertices (Rec ds) =-  any (isUsed' mn graph vertexFor entryPointVertices . fst) ds---- |--- Check whether a named declaration is used.----isUsed' :: ModuleName -> Graph -> (Key -> Maybe Vertex) -> [Vertex] -> Ident -> Bool-isUsed' mn graph vertexFor entryPointVertices name =-  let Just v' = vertexFor (mn, name)-  in any (\v -> path graph v v') entryPointVertices

+ src/Language/PureScript/Docs.hs view

@@ -0,0 +1,14 @@++-- | Data types and functions for rendering generated documentation from+-- PureScript code, in a variety of formats.++module Language.PureScript.Docs (+  module Docs+) where++import Language.PureScript.Docs.Types as Docs+import Language.PureScript.Docs.RenderedCode.Types as Docs+import Language.PureScript.Docs.RenderedCode.Render as Docs+import Language.PureScript.Docs.Convert as Docs+import Language.PureScript.Docs.Render as Docs+import Language.PureScript.Docs.ParseAndDesugar as Docs

+ src/Language/PureScript/Docs/AsMarkdown.hs view

@@ -0,0 +1,124 @@+{-# LANGUAGE RecordWildCards #-}++module Language.PureScript.Docs.AsMarkdown (+  renderModulesAsMarkdown+) where++import Control.Monad.Writer hiding (First)+import Data.Foldable (for_)+import Data.List (partition)++import qualified Language.PureScript as P++import Language.PureScript.Docs.Types+import Language.PureScript.Docs.RenderedCode+import qualified Language.PureScript.Docs.Convert as Convert+import qualified Language.PureScript.Docs.Render as Render++-- |+-- Take a list of modules and render them all in order, returning a single+-- Markdown-formatted String.+--+renderModulesAsMarkdown :: [P.Module] -> String+renderModulesAsMarkdown =+  runDocs . modulesAsMarkdown . map Convert.convertModule++modulesAsMarkdown :: [Module] -> Docs+modulesAsMarkdown = mapM_ moduleAsMarkdown++moduleAsMarkdown :: Module -> Docs+moduleAsMarkdown Module{..} = do+  headerLevel 2 $ "Module " ++ modName+  spacer+  for_ modComments tell'+  mapM_ declAsMarkdown modDeclarations+  spacer++declAsMarkdown :: Declaration -> Docs+declAsMarkdown decl@Declaration{..} = do+  headerLevel 4 (ticks declTitle)+  spacer++  let (instances, children) = partition (isChildInstance . cdeclInfo) declChildren+  fencedBlock $ do+    tell' (codeToString $ Render.renderDeclaration decl)+    zipWithM_ (\f c -> tell' (childToString f c)) (First : repeat NotFirst) children+  spacer++  for_ declFixity (\fixity -> fixityAsMarkdown fixity >> spacer)++  for_ declComments tell'++  unless (null instances) $ do+    headerLevel 5 "Instances"+    fencedBlock $ mapM_ (tell' . childToString NotFirst) instances+    spacer++  where+  isChildInstance (ChildInstance _ _) = True+  isChildInstance _ = False++codeToString :: RenderedCode -> String+codeToString = outputWith elemAsMarkdown+  where+  elemAsMarkdown (Syntax x)  = x+  elemAsMarkdown (Ident x)   = x+  elemAsMarkdown (Ctor x _)  = x+  elemAsMarkdown (Kind x)    = x+  elemAsMarkdown (Keyword x) = x+  elemAsMarkdown Space       = " "++fixityAsMarkdown :: P.Fixity -> Docs+fixityAsMarkdown (P.Fixity associativity precedence) =+  tell' $ concat [ "_"+                 , associativityStr+                 , " / precedence "+                 , show precedence+                 , "_"+                 ]+  where+  associativityStr = case associativity of+    P.Infixl -> "left-associative"+    P.Infixr -> "right-associative"+    P.Infix  -> "non-associative"++childToString :: First -> ChildDeclaration -> String+childToString f decl@ChildDeclaration{..} =+  case cdeclInfo of+    ChildDataConstructor _ ->+      let c = if f == First then "=" else "|"+      in  "  " ++ c ++ " " ++ str+    ChildTypeClassMember _ ->+      "  " ++ str+    ChildInstance _ _ ->+      str+  where+  str = codeToString $ Render.renderChildDeclaration decl++data First+  = First+  | NotFirst+  deriving (Show, Eq, Ord)++type Docs = Writer [String] ()++runDocs :: Docs -> String+runDocs = unlines . execWriter++tell' :: String -> Docs+tell' = tell . (:[])++spacer :: Docs+spacer = tell' ""++headerLevel :: Int -> String -> Docs+headerLevel level hdr = tell' (replicate level '#' ++ ' ' : hdr)++fencedBlock :: Docs -> Docs+fencedBlock inner = do+  tell' "``` purescript"+  inner+  tell' "```"++ticks :: String -> String+ticks = ("`" ++) . (++ "`")

+ src/Language/PureScript/Docs/Convert.hs view

@@ -0,0 +1,228 @@+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ViewPatterns #-}++-- | Functions for converting PureScript ASTs into values of the data types+-- from Language.PureScript.Docs.++module Language.PureScript.Docs.Convert+  ( convertModule+  , collectBookmarks+  ) where++import Control.Monad+import Control.Category ((>>>))+import Data.Either+import Data.Maybe (mapMaybe, isNothing)+import Data.List (nub, isPrefixOf, isSuffixOf)++import qualified Language.PureScript as P++import Language.PureScript.Docs.Types++-- |+-- Convert a single Module.+--+convertModule :: P.Module -> Module+convertModule m@(P.Module coms moduleName  _ _) =+  Module (show moduleName) comments (declarations m)+  where+  comments = convertComments coms+  declarations =+    P.exportedDeclarations+    >>> mapMaybe (\d -> getDeclarationTitle d >>= convertDeclaration d)+    >>> augmentDeclarations+    >>> map addDefaultFixity++-- | The data type for an intermediate stage which we go through during+-- converting.+--+-- In the first pass, we take all top level declarations in the module, and+-- collect other information which will later be used to augment the top level+-- declarations. These two situation correspond to the Right and Left+-- constructors, respectively.+--+-- In the second pass, we go over all of the Left values and augment the+-- relevant declarations, leaving only the augmented Right values.+--+-- Note that in the Left case, we provide a [String] as well as augment+-- information. The [String] value should be a list of titles of declarations+-- that the augmentation should apply to. For example, for a type instance+-- declaration, that would be any types or type classes mentioned in the+-- instance. For a fixity declaration, it would be just the relevant operator's+-- name.+type IntermediateDeclaration+  = Either ([String], DeclarationAugment) Declaration++-- | Some data which will be used to augment a Declaration in the+-- output.+--+-- The AugmentChild constructor allows us to move all children under their+-- respective parents. It is only necessary for type instance declarations,+-- since they appear at the top level in the AST, and since they might need to+-- appear as children in two places (for example, if a data type defined in a+-- module is an instance of a type class also defined in that module).+--+-- The AugmentFixity constructor allows us to augment operator definitions+-- with their associativity and precedence.+data DeclarationAugment+  = AugmentChild ChildDeclaration+  | AugmentFixity P.Fixity++-- | Augment top-level declarations; the second pass. See the comments under+-- the type synonym IntermediateDeclaration for more information.+augmentDeclarations :: [IntermediateDeclaration] -> [Declaration]+augmentDeclarations (partitionEithers -> (augments, toplevels)) =+  foldl go toplevels augments+  where+  go ds (parentTitles, a) =+    map (\d ->+      if declTitle d `elem` parentTitles+        then augmentWith a d+        else d) ds++  augmentWith a d =+    case a of+      AugmentChild child ->+        d { declChildren = declChildren d ++ [child] }+      AugmentFixity fixity ->+        d { declFixity = Just fixity }++-- | Add the default operator fixity for operators which do not have associated+-- fixity declarations.+--+-- TODO: This may no longer be necessary after issue 806 is resolved, hopefully+-- in 0.8.+addDefaultFixity :: Declaration -> Declaration+addDefaultFixity decl@Declaration{..}+  | isOp declTitle && isNothing declFixity =+        decl { declFixity = Just defaultFixity }+  | otherwise =+        decl+  where+  isOp :: String -> Bool+  isOp str = "(" `isPrefixOf` str && ")" `isSuffixOf` str+  defaultFixity = P.Fixity P.Infixl (-1)++getDeclarationTitle :: P.Declaration -> Maybe String+getDeclarationTitle (P.TypeDeclaration name _)               = Just (show name)+getDeclarationTitle (P.ExternDeclaration name _)             = Just (show name)+getDeclarationTitle (P.DataDeclaration _ name _ _)           = Just (show name)+getDeclarationTitle (P.ExternDataDeclaration name _)         = Just (show name)+getDeclarationTitle (P.TypeSynonymDeclaration name _ _)      = Just (show name)+getDeclarationTitle (P.TypeClassDeclaration name _ _ _)      = Just (show name)+getDeclarationTitle (P.TypeInstanceDeclaration name _ _ _ _) = Just (show name)+getDeclarationTitle (P.FixityDeclaration _ name)             = Just ("(" ++ name ++ ")")+getDeclarationTitle (P.PositionedDeclaration _ _ d)          = getDeclarationTitle d+getDeclarationTitle _                                        = Nothing++-- | Create a basic Declaration value.+mkDeclaration :: String -> DeclarationInfo -> Declaration+mkDeclaration title info =+  Declaration { declTitle      = title+              , declComments   = Nothing+              , declSourceSpan = Nothing+              , declChildren   = []+              , declFixity     = Nothing+              , declInfo       = info+              }++basicDeclaration :: String -> DeclarationInfo -> Maybe IntermediateDeclaration+basicDeclaration title info = Just $ Right $ mkDeclaration title info++convertDeclaration :: P.Declaration -> String -> Maybe IntermediateDeclaration+convertDeclaration (P.TypeDeclaration _ ty) title =+  basicDeclaration title (ValueDeclaration ty)+convertDeclaration (P.ExternDeclaration _ ty) title =+  basicDeclaration title (ValueDeclaration ty)+convertDeclaration (P.DataDeclaration dtype _ args ctors) title =+  Just (Right (mkDeclaration title info) { declChildren = children })+  where+  info = DataDeclaration dtype args+  children = map convertCtor ctors+  convertCtor (ctor', tys) =+    ChildDeclaration (show ctor') Nothing Nothing (ChildDataConstructor tys)+convertDeclaration (P.ExternDataDeclaration _ kind') title =+  basicDeclaration title (ExternDataDeclaration kind')+convertDeclaration (P.TypeSynonymDeclaration _ args ty) title =+  basicDeclaration title (TypeSynonymDeclaration args ty)+convertDeclaration (P.TypeClassDeclaration _ args implies ds) title = do+  Just (Right (mkDeclaration title info) { declChildren = children })+  where+  info = TypeClassDeclaration args implies+  children = map convertClassMember ds+  convertClassMember (P.PositionedDeclaration _ _ d) =+    convertClassMember d+  convertClassMember (P.TypeDeclaration ident' ty) =+    ChildDeclaration (show ident') Nothing Nothing (ChildTypeClassMember ty)+  convertClassMember _ =+    error "Invalid argument to convertClassMember."+convertDeclaration (P.TypeInstanceDeclaration _ constraints className tys _) title = do+  Just (Left (classNameString : typeNameStrings, AugmentChild childDecl))+  where+  classNameString = unQual className+  typeNameStrings = nub (concatMap (P.everythingOnTypes (++) extractProperNames) tys)+  unQual x = let (P.Qualified _ y) = x in show y++  extractProperNames (P.TypeConstructor n) = [unQual n]+  extractProperNames (P.SaturatedTypeSynonym n _) = [unQual n]+  extractProperNames _ = []++  childDecl = ChildDeclaration title Nothing Nothing (ChildInstance constraints classApp)+  classApp = foldl P.TypeApp (P.TypeConstructor className) tys+convertDeclaration (P.FixityDeclaration fixity _) title =+  Just (Left ([title], AugmentFixity fixity))+convertDeclaration (P.PositionedDeclaration srcSpan com d') title =+  fmap (addComments . addSourceSpan) (convertDeclaration d' title)+  where+  addComments (Right d) =+    Right (d { declComments = convertComments com })+  addComments (Left augment) =+    Left (withAugmentChild (\d -> d { cdeclComments = convertComments com })+                           augment)++  addSourceSpan (Right d) =+    Right (d { declSourceSpan = Just srcSpan })+  addSourceSpan (Left augment) =+    Left (withAugmentChild (\d -> d { cdeclSourceSpan = Just srcSpan })+                           augment)++  withAugmentChild f (t, a) =+    case a of+      AugmentChild d -> (t, AugmentChild (f d))+      _              -> (t, a)+convertDeclaration _ _ = Nothing++convertComments :: [P.Comment] -> Maybe String+convertComments cs = do+  let raw = concatMap toLines cs+  guard (all hasPipe raw && not (null raw))+  return (go raw)+  where+  go = unlines . map stripPipes++  toLines (P.LineComment s) = [s]+  toLines (P.BlockComment s) = lines s++  hasPipe s = case dropWhile (== ' ') s of { ('|':_) -> True; _ -> False }++  stripPipes = dropPipe . dropWhile (== ' ')++  dropPipe ('|':' ':s) = s+  dropPipe ('|':s) = s+  dropPipe s = s++-- | Go through a PureScript module and extract a list of Bookmarks; references+-- to data types or values, to be used as a kind of index. These are used for+-- generating links in the HTML documentation, for example.+collectBookmarks :: InPackage P.Module -> [Bookmark]+collectBookmarks (Local m) = map Local (collectBookmarks' m)+collectBookmarks (FromDep pkg m) = map (FromDep pkg) (collectBookmarks' m)++collectBookmarks' :: P.Module -> [(P.ModuleName, String)]+collectBookmarks' m =+  map (P.getModuleName m, )+      (mapMaybe getDeclarationTitle+                (P.exportedDeclarations m))+

+ src/Language/PureScript/Docs/ParseAndDesugar.hs view

@@ -0,0 +1,120 @@+{-# LANGUAGE TupleSections #-}++module Language.PureScript.Docs.ParseAndDesugar+  ( parseAndDesugar+  , ParseDesugarError(..)+  ) where++import qualified Data.Map as M+import Control.Arrow (first)+import Control.Monad+import Control.Applicative++import Control.Monad.Trans.Except+import Control.Monad.Error.Class (MonadError(..))+import Control.Monad.IO.Class (MonadIO(..))++import Web.Bower.PackageMeta (PackageName)++import qualified Language.PureScript as P+import qualified Language.PureScript.Constants as C+import Language.PureScript.Docs.Types+import Language.PureScript.Docs.Convert (collectBookmarks)++data ParseDesugarError+  = ParseError P.MultipleErrors+  | SortModulesError P.MultipleErrors+  | DesugarError P.MultipleErrors+  deriving (Show)++-- |+-- Given:+--+--    * A list of local source files+--    * A list of source files from external dependencies, together with their+--      package names+--    * A callback, taking a list of bookmarks, and a list of desugared modules+--+-- This function does the following:+--+--    * Parse all of the input and dependency source files+--    * Partially desugar all of the resulting modules+--    * Collect a list of bookmarks from the whole set of source files+--    * Collect a list of desugared modules from just the input source files (not+--      dependencies)+--    * Call the callback with the bookmarks and desugared module list.+parseAndDesugar ::+  [FilePath]+  -> [(PackageName, FilePath)]+  -> ([Bookmark] -> [P.Module] -> IO a)+  -> IO (Either ParseDesugarError a)+parseAndDesugar inputFiles depsFiles callback = do+  inputFiles' <- mapM (parseAs Local) inputFiles+  depsFiles'  <- mapM (\(pkgName, f) -> parseAs (FromDep pkgName) f) depsFiles++  runExceptT $ do+    let eParsed = P.parseModulesFromFiles fileInfoToString (inputFiles' ++ depsFiles')+    ms <- throwLeft ParseError eParsed++    let depsModules = getDepsModuleNames (map (\(fp, m) -> (,m) <$> fp) ms)+    let eSorted = P.sortModules . map (importPrim . snd) $ ms+    (ms', _) <- throwLeft SortModulesError eSorted++    modules <- throwLeft DesugarError (desugar ms')+    let modules' = map (addPackage depsModules) modules+        bookmarks = concatMap collectBookmarks modules'+    liftIO (callback bookmarks (takeLocals modules'))++  where+  throwLeft f = either (throwError . f) return++-- | Specifies whether a PureScript source file is considered as:+--+-- 1) with the `Local` constructor, a target source file, i.e., we want to see+--    its modules in the output+-- 2) with the `FromDep` constructor, a dependencies source file, i.e. we do+--    not want its modules in the output; it is there to enable desugaring, and+--    to ensure that links between modules are constructed correctly.+type FileInfo = InPackage FilePath++fileInfoToString :: FileInfo -> FilePath+fileInfoToString (Local fn) = fn+fileInfoToString (FromDep _ fn) = fn++addDefaultImport :: P.ModuleName -> P.Module -> P.Module+addDefaultImport toImport m@(P.Module coms mn decls exps)  =+  if isExistingImport `any` decls || mn == toImport then m+  else P.Module coms mn (P.ImportDeclaration toImport P.Implicit Nothing : decls) exps+  where+  isExistingImport (P.ImportDeclaration mn' _ _) | mn' == toImport = True+  isExistingImport (P.PositionedDeclaration _ _ d) = isExistingImport d+  isExistingImport _ = False++importPrim :: P.Module -> P.Module+importPrim = addDefaultImport (P.ModuleName [P.ProperName C.prim])++desugar :: [P.Module] -> Either P.MultipleErrors [P.Module]+desugar = P.evalSupplyT 0 . desugar'+  where+  desugar' :: [P.Module] -> P.SupplyT (Either P.MultipleErrors) [P.Module]+  desugar' = mapM P.desugarDoModule >=> P.desugarCasesModule >=> P.desugarImports++parseFile :: FilePath -> IO (FilePath, String)+parseFile input' = (,) input' <$> readFile input'++parseAs :: (FilePath -> a) -> FilePath -> IO (a, String)+parseAs g = fmap (first g) . parseFile++getDepsModuleNames :: [InPackage (FilePath, P.Module)] -> M.Map P.ModuleName PackageName+getDepsModuleNames = foldl go M.empty+  where+  go deps p = deps # case p of+    Local _ -> id+    FromDep pkgName (_, m) -> M.insert (P.getModuleName m) pkgName+  (#) = flip ($)++addPackage :: M.Map P.ModuleName PackageName -> P.Module -> InPackage P.Module+addPackage depsModules m =+  case M.lookup (P.getModuleName m) depsModules of+    Just pkgName -> FromDep pkgName m+    Nothing -> Local m

+ src/Language/PureScript/Docs/Render.hs view

@@ -0,0 +1,127 @@+{-# LANGUAGE RecordWildCards #-}++-- | Functions for creating `RenderedCode` values from data types in+-- Language.PureScript.Docs.Types.+--+-- These functions are the ones that are used in markdown/html documentation+-- generation, but the intention is that you are able to supply your own+-- instead if necessary. For example, the Hoogle input file generator+-- substitutes some of these++module Language.PureScript.Docs.Render where++import Data.Monoid ((<>))+import qualified Language.PureScript as P++import Language.PureScript.Docs.Types+import Language.PureScript.Docs.RenderedCode+import Language.PureScript.Docs.Utils.MonoidExtras++renderDeclaration :: Declaration -> RenderedCode+renderDeclaration = renderDeclarationWithOptions defaultRenderTypeOptions++renderDeclarationWithOptions :: RenderTypeOptions -> Declaration -> RenderedCode+renderDeclarationWithOptions opts Declaration{..} =+  mintersperse sp $ case declInfo of+    ValueDeclaration ty ->+      [ ident declTitle+      , syntax "::"+      , renderType' ty+      ]+    DataDeclaration dtype args ->+      [ keyword (show dtype)+      , renderType' (typeApp declTitle args)+      ]+    ExternDataDeclaration kind' ->+      [ keywordData+      , renderType' (P.TypeConstructor (notQualified declTitle))+      , syntax "::"+      , renderKind kind'+      ]+    TypeSynonymDeclaration args ty ->+      [ keywordType+      , renderType' (typeApp declTitle args)+      , syntax "="+      , renderType' ty+      ]+    TypeClassDeclaration args implies ->+      [ keywordClass ]+      ++ maybe [] (:[]) superclasses+      ++ [renderType' (typeApp declTitle args)]+      ++ if any (isTypeClassMember . cdeclInfo) declChildren+            then [keywordWhere]+            else []++      where+      superclasses+        | null implies = Nothing+        | otherwise = Just $+            syntax "("+            <> mintersperse (syntax "," <> sp) (map renderConstraint implies)+            <> syntax ")" <> sp <> syntax "<="++      isTypeClassMember (ChildTypeClassMember _) = True+      isTypeClassMember _ = False+  where+  renderType' = renderTypeWithOptions opts++renderChildDeclaration :: ChildDeclaration -> RenderedCode+renderChildDeclaration = renderChildDeclarationWithOptions defaultRenderTypeOptions++renderChildDeclarationWithOptions :: RenderTypeOptions -> ChildDeclaration -> RenderedCode+renderChildDeclarationWithOptions opts ChildDeclaration{..} =+  mintersperse sp $ case cdeclInfo of+    ChildInstance constraints ty ->+      [ keywordInstance+      , ident cdeclTitle+      , syntax "::"+      ] ++ maybe [] (:[]) (renderConstraints constraints)+        ++ [ renderType' ty ]+    ChildDataConstructor args ->+      [ renderType' typeApp' ]+      where+      typeApp' = foldl P.TypeApp ctor' args+      ctor' = P.TypeConstructor (notQualified cdeclTitle)++    ChildTypeClassMember ty ->+      [ ident cdeclTitle+      , syntax "::"+      , renderType' ty+      ]+  where+  renderType' = renderTypeWithOptions opts++renderConstraint :: (P.Qualified P.ProperName, [P.Type]) -> RenderedCode+renderConstraint = renderConstraintWithOptions defaultRenderTypeOptions++renderConstraintWithOptions :: RenderTypeOptions -> (P.Qualified P.ProperName, [P.Type]) -> RenderedCode+renderConstraintWithOptions opts (pn, tys) =+  renderTypeWithOptions opts $ foldl P.TypeApp (P.TypeConstructor pn) tys++renderConstraints :: [P.Constraint] -> Maybe RenderedCode+renderConstraints = renderConstraintsWithOptions defaultRenderTypeOptions++renderConstraintsWithOptions :: RenderTypeOptions -> [P.Constraint] -> Maybe RenderedCode+renderConstraintsWithOptions opts constraints+  | null constraints = Nothing+  | otherwise = Just $+        syntax "("+        <> renderedConstraints+        <> syntax ")" <> sp <> syntax "=>"+  where+  renderedConstraints =+    mintersperse (syntax "," <> sp)+                 (map (renderConstraintWithOptions opts) constraints)++notQualified :: String -> P.Qualified P.ProperName+notQualified = P.Qualified Nothing . P.ProperName++typeApp :: String -> [(String, Maybe P.Kind)] -> P.Type+typeApp title typeArgs =+  foldl P.TypeApp+        (P.TypeConstructor (notQualified title))+        (map toTypeVar typeArgs)++toTypeVar :: (String, Maybe P.Kind) -> P.Type+toTypeVar (s, Nothing) = P.TypeVar s+toTypeVar (s, Just k) = P.KindedType (P.TypeVar s) k

+ src/Language/PureScript/Docs/RenderedCode.hs view

@@ -0,0 +1,11 @@++-- | Data types and functions for representing a simplified form of PureScript+-- code, intended for use in e.g. HTML documentation.++module Language.PureScript.Docs.RenderedCode (+  module RenderedCode+) where++import Language.PureScript.Docs.RenderedCode.Types as RenderedCode+import Language.PureScript.Docs.RenderedCode.Render as RenderedCode+

+ src/Language/PureScript/Docs/RenderedCode/Render.hs view

@@ -0,0 +1,179 @@++-- | Functions for producing RenderedCode values from PureScript Type values.++module Language.PureScript.Docs.RenderedCode.Render (+    renderType,+    renderTypeAtom,+    renderRow,+    renderKind,+    RenderTypeOptions(..),+    defaultRenderTypeOptions,+    renderTypeWithOptions+) where++import Data.Monoid ((<>), mconcat, mempty)+import Data.Maybe (fromMaybe)++import Control.Arrow ((<+>))+import Control.PatternArrows++import Language.PureScript.Names+import Language.PureScript.Types+import Language.PureScript.Kinds+import Language.PureScript.Pretty.Kinds+import Language.PureScript.Environment++import Language.PureScript.Docs.RenderedCode.Types+import Language.PureScript.Docs.Utils.MonoidExtras++typeLiterals :: Pattern () Type RenderedCode+typeLiterals = mkPattern match+  where+  match TypeWildcard =+    Just (syntax "_")+  match (TypeVar var) =+    Just (ident var)+  match (PrettyPrintObject row) =+    Just $ mintersperse sp+              [ syntax "{"+              , renderRow row+              , syntax "}"+              ]+  match (TypeConstructor (Qualified mn name)) =+    Just (ctor (show name) (maybeToContainingModule mn))+  match (ConstrainedType deps ty) =+    Just $ mintersperse sp+            [ syntax "(" <> constraints <> syntax ")"+            , syntax "=>"+            , renderType ty+            ]+    where+    constraints = mintersperse (syntax "," <> sp) (map renderDep deps)+    renderDep (pn, tys) =+        let instApp = foldl TypeApp (TypeConstructor pn) tys+        in  renderType instApp+  match REmpty =+    Just (syntax "()")+  match row@RCons{} =+    Just (syntax "(" <> renderRow row <> syntax ")")+  match _ =+    Nothing++-- |+-- Render code representing a Row+--+renderRow :: Type -> RenderedCode+renderRow = uncurry renderRow' . rowToList+  where+  renderRow' h t = renderHead h <> renderTail t++renderHead :: [(String, Type)] -> RenderedCode+renderHead = mintersperse (syntax "," <> sp) . map renderLabel++renderLabel :: (String, Type) -> RenderedCode+renderLabel (label, ty) =+  mintersperse sp+    [ ident label+    , syntax "::"+    , renderType ty+    ]++renderTail :: Type -> RenderedCode+renderTail REmpty = mempty+renderTail other = sp <> syntax "|" <> sp <> renderType other++typeApp :: Pattern () Type (Type, Type)+typeApp = mkPattern match+  where+  match (TypeApp f x) = Just (f, x)+  match _ = Nothing++appliedFunction :: Pattern () Type (Type, Type)+appliedFunction = mkPattern match+  where+  match (PrettyPrintFunction arg ret) = Just (arg, ret)+  match _ = Nothing++kinded :: Pattern () Type (Kind, Type)+kinded = mkPattern match+  where+  match (KindedType t k) = Just (k, t)+  match _ = Nothing++matchTypeAtom :: Pattern () Type RenderedCode+matchTypeAtom = typeLiterals <+> fmap parens matchType+  where+  parens x = syntax "(" <> x <> syntax ")"++matchType :: Pattern () Type RenderedCode+matchType = buildPrettyPrinter operators matchTypeAtom+  where+  operators :: OperatorTable () Type RenderedCode+  operators =+    OperatorTable [ [ AssocL typeApp $ \f x -> f <> sp <> x ]+                  , [ AssocR appliedFunction $ \arg ret -> mintersperse sp [arg, syntax "->", ret] ]+                  , [ Wrap forall_ $ \idents ty -> mconcat [syntax "forall", sp, mintersperse sp (map ident idents), syntax ".", sp, ty] ]+                  , [ Wrap kinded $ \k ty -> mintersperse sp [ty, syntax "::", renderKind k] ]+                  ]++forall_ :: Pattern () Type ([String], Type)+forall_ = mkPattern match+  where+  match (PrettyPrintForAll idents ty) = Just (idents, ty)+  match _ = Nothing++insertPlaceholders :: RenderTypeOptions -> Type -> Type+insertPlaceholders opts =+  everywhereOnTypesTopDown convertForAlls . everywhereOnTypes (convert opts)++dePrim :: Type -> Type+dePrim ty@(TypeConstructor (Qualified _ name))+  | ty == tyBoolean || ty == tyNumber || ty == tyString =+    TypeConstructor $ Qualified Nothing name+dePrim other = other++convert :: RenderTypeOptions -> Type -> Type+convert _ (TypeApp (TypeApp f arg) ret) | f == tyFunction = PrettyPrintFunction arg ret+convert opts (TypeApp o r) | o == tyObject && prettyPrintObjects opts = PrettyPrintObject r+convert _ other = other++convertForAlls :: Type -> Type+convertForAlls (ForAll i ty _) = go [i] ty+  where+  go idents (ForAll ident' ty' _) = go (ident' : idents) ty'+  go idents other = PrettyPrintForAll idents other+convertForAlls other = other++preprocessType :: RenderTypeOptions -> Type -> Type+preprocessType opts = dePrim . insertPlaceholders opts++-- |+-- Render code representing a Kind+--+renderKind :: Kind -> RenderedCode+renderKind = kind . prettyPrintKind++-- |+-- Render code representing a Type, as it should appear inside parentheses+--+renderTypeAtom :: Type -> RenderedCode+renderTypeAtom =+  fromMaybe (error "Incomplete pattern") . pattern matchTypeAtom () . preprocessType defaultRenderTypeOptions+++-- |+-- Render code representing a Type+--+renderType :: Type -> RenderedCode+renderType = renderTypeWithOptions defaultRenderTypeOptions++data RenderTypeOptions = RenderTypeOptions+  { prettyPrintObjects :: Bool+  }++defaultRenderTypeOptions :: RenderTypeOptions+defaultRenderTypeOptions = RenderTypeOptions { prettyPrintObjects = True }++renderTypeWithOptions :: RenderTypeOptions -> Type -> RenderedCode+renderTypeWithOptions opts =+  fromMaybe (error "Incomplete pattern") . pattern matchType () . preprocessType opts

+ src/Language/PureScript/Docs/RenderedCode/Types.hs view

@@ -0,0 +1,191 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Data types and functions for representing a simplified form of PureScript+-- code, intended for use in e.g. HTML documentation.++module Language.PureScript.Docs.RenderedCode.Types+ ( RenderedCodeElement(..)+ , asRenderedCodeElement+ , ContainingModule(..)+ , asContainingModule+ , containingModuleToMaybe+ , maybeToContainingModule+ , fromContainingModule+ , RenderedCode+ , asRenderedCode+ , outputWith+ , sp+ , syntax+ , ident+ , ctor+ , kind+ , keyword+ , keywordForall+ , keywordData+ , keywordNewtype+ , keywordType+ , keywordClass+ , keywordInstance+ , keywordWhere+ ) where++import Control.Applicative ((<$>), (<*>), (*>), pure)+import Data.Foldable+import Data.Monoid+import qualified Data.Aeson as A+import Data.Aeson.BetterErrors+import Control.Monad.Error.Class (MonadError(..))++import qualified Language.PureScript as P++-- |+-- A single element in a rendered code fragment. The intention is to support+-- multiple output formats. For example, plain text, or highlighted HTML.+--+data RenderedCodeElement+  = Syntax String+  | Ident String+  | Ctor String ContainingModule+  | Kind String+  | Keyword String+  | Space+  deriving (Show, Eq, Ord)++instance A.ToJSON RenderedCodeElement where+  toJSON (Syntax str) =+    A.toJSON ["syntax", str]+  toJSON (Ident str) =+    A.toJSON ["ident", str]+  toJSON (Ctor str mn) =+    A.toJSON ["ctor", A.toJSON str, A.toJSON mn ]+  toJSON (Kind str) =+    A.toJSON ["kind", str]+  toJSON (Keyword str) =+    A.toJSON ["keyword", str]+  toJSON Space =+    A.toJSON ["space" :: String]++asRenderedCodeElement :: Parse String RenderedCodeElement+asRenderedCodeElement =+  a Syntax "syntax" <|>+  a Ident "ident" <|>+  asCtor <|>+  a Kind "kind" <|>+  a Keyword "keyword" <|>+  asSpace <|>+  unableToParse+  where+  p <|> q = catchError p (const q)++  a ctor' ctorStr = ctor' <$> (nth 0 (withString (eq ctorStr)) *> nth 1 asString)+  asCtor = nth 0 (withString (eq "ctor")) *> (Ctor <$> nth 1 asString <*> nth 2 asContainingModule)+  asSpace = nth 0 (withString (eq "space")) *> pure Space++  eq s s' = if s == s' then Right () else Left ""++  unableToParse = withString (Left . show)++-- |+-- This type is isomorphic to 'Maybe' 'P.ModuleName'. It makes code a bit easier+-- to read, as the meaning is more explicit.+--+data ContainingModule+  = ThisModule+  | OtherModule P.ModuleName+  deriving (Show, Eq, Ord)++instance A.ToJSON ContainingModule where+  toJSON mn = A.toJSON (P.runModuleName <$> containingModuleToMaybe mn)++asContainingModule :: Parse e ContainingModule+asContainingModule =+  maybeToContainingModule <$> perhaps (P.moduleNameFromString <$> asString)++-- |+-- Convert a 'Maybe' 'P.ModuleName' to a 'ContainingModule', using the obvious+-- isomorphism.+--+maybeToContainingModule :: Maybe P.ModuleName -> ContainingModule+maybeToContainingModule Nothing = ThisModule+maybeToContainingModule (Just mn) = OtherModule mn++-- |+-- Convert a 'ContainingModule' to a 'Maybe' 'P.ModuleName', using the obvious+-- isomorphism.+--+containingModuleToMaybe :: ContainingModule -> Maybe P.ModuleName+containingModuleToMaybe ThisModule = Nothing+containingModuleToMaybe (OtherModule mn) = Just mn++-- |+-- A version of 'fromMaybe' for 'ContainingModule' values.+--+fromContainingModule :: P.ModuleName -> ContainingModule -> P.ModuleName+fromContainingModule def ThisModule = def+fromContainingModule _ (OtherModule mn) = mn++-- |+-- A type representing a highly simplified version of PureScript code, intended+-- for use in output formats like plain text or HTML.+--+newtype RenderedCode+  = RC { unRC :: [RenderedCodeElement] }+  deriving (Show, Eq, Ord, Monoid)++instance A.ToJSON RenderedCode where+  toJSON (RC elems) = A.toJSON elems++asRenderedCode :: Parse String RenderedCode+asRenderedCode = RC <$> eachInArray asRenderedCodeElement++-- |+-- This function allows conversion of a 'RenderedCode' value into a value of+-- some other type (for example, plain text, or HTML). The first argument+-- is a function specifying how each individual 'RenderedCodeElement' should be+-- rendered.+--+outputWith :: Monoid a => (RenderedCodeElement -> a) -> RenderedCode -> a+outputWith f = foldMap f . unRC++-- |+-- A 'RenderedCode' fragment representing a space.+--+sp :: RenderedCode+sp = RC [Space]++syntax :: String -> RenderedCode+syntax x = RC [Syntax x]++ident :: String -> RenderedCode+ident x = RC [Ident x]++ctor :: String -> ContainingModule -> RenderedCode+ctor x m = RC [Ctor x m]++kind :: String -> RenderedCode+kind x = RC [Kind x]++keyword :: String -> RenderedCode+keyword kw = RC [Keyword kw]++keywordForall :: RenderedCode+keywordForall = keyword "forall"++keywordData :: RenderedCode+keywordData = keyword "data"++keywordNewtype :: RenderedCode+keywordNewtype = keyword "newtype"++keywordType :: RenderedCode+keywordType = keyword "type"++keywordClass :: RenderedCode+keywordClass = keyword "class"++keywordInstance :: RenderedCode+keywordInstance = keyword "instance"++keywordWhere :: RenderedCode+keywordWhere = keyword "where"

+ src/Language/PureScript/Docs/Types.hs view

@@ -0,0 +1,472 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE RankNTypes #-}++module Language.PureScript.Docs.Types+  ( module Language.PureScript.Docs.Types+  , module ReExports+  )+  where++import Control.Arrow (first, (***))+import Control.Applicative ((<$>), (<*>))+import Data.Functor ((<$))+import Data.Maybe (mapMaybe)+import Data.Version+import Data.Aeson ((.=))+import qualified Data.Aeson as A+import Data.Aeson.BetterErrors+import Text.ParserCombinators.ReadP (readP_to_S)+import Data.Text (Text)+import Data.ByteString.Lazy (ByteString)+import qualified Data.Text as T++import Web.Bower.PackageMeta hiding (Version)++import qualified Language.PureScript as P++import Language.PureScript.Docs.RenderedCode as ReExports+  (RenderedCode, asRenderedCode,+   ContainingModule(..), asContainingModule,+   RenderedCodeElement(..), asRenderedCodeElement)++--------------------+-- Types++data Package a = Package+  { pkgMeta                 :: PackageMeta+  , pkgVersion              :: Version+  , pkgVersionTag           :: String+  , pkgModules              :: [Module]+  , pkgBookmarks            :: [Bookmark]+  , pkgResolvedDependencies :: [(PackageName, Version)]+  , pkgGithub               :: (GithubUser, GithubRepo)+  , pkgUploader             :: a+  }+  deriving (Show, Eq, Ord)++data NotYetKnown = NotYetKnown+  deriving (Show, Eq, Ord)++type UploadedPackage = Package NotYetKnown+type VerifiedPackage = Package GithubUser++verifyPackage :: GithubUser -> UploadedPackage -> VerifiedPackage+verifyPackage verifiedUser Package{..} =+  Package pkgMeta+          pkgVersion+          pkgVersionTag+          pkgModules+          pkgBookmarks+          pkgResolvedDependencies+          pkgGithub+          verifiedUser++packageName :: Package a -> PackageName+packageName = bowerName . pkgMeta++data Module = Module+  { modName         :: String+  , modComments     :: Maybe String+  , modDeclarations :: [Declaration]+  }+  deriving (Show, Eq, Ord)++data Declaration = Declaration+  { declTitle      :: String+  , declComments   :: Maybe String+  , declSourceSpan :: Maybe P.SourceSpan+  , declChildren   :: [ChildDeclaration]+  , declFixity     :: Maybe P.Fixity+  , declInfo       :: DeclarationInfo+  }+  deriving (Show, Eq, Ord)++-- |+-- 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+-- declarations, which goes into the 'Declaration' type directly).+--+-- Many of the constructors are very similar to their equivalents in the real+-- PureScript AST, except that they have their name elided, since this is+-- already available via the rdTitle field of 'Declaration'.+--+data DeclarationInfo+  -- |+  -- A value declaration, with its type.+  --+  = ValueDeclaration P.Type++  -- |+  -- A data/newtype declaration, with the kind of declaration (data or+  -- newtype) and its type arguments. Constructors are represented as child+  -- declarations.+  --+  | DataDeclaration P.DataDeclType [(String, Maybe P.Kind)]++  -- |+  -- A data type foreign import, with its kind.+  --+  | ExternDataDeclaration P.Kind++  -- |+  -- A type synonym, with its type arguments and its type.+  --+  | TypeSynonymDeclaration [(String, Maybe P.Kind)] P.Type++  -- |+  -- A type class, with its type arguments and its superclasses. Instances and+  -- members are represented as child declarations.+  --+  | TypeClassDeclaration [(String, Maybe P.Kind)] [P.Constraint]+  deriving (Show, Eq, Ord)++declInfoToString :: DeclarationInfo -> String+declInfoToString (ValueDeclaration _) = "value"+declInfoToString (DataDeclaration _ _) = "data"+declInfoToString (ExternDataDeclaration _) = "externData"+declInfoToString (TypeSynonymDeclaration _ _) = "typeSynonym"+declInfoToString (TypeClassDeclaration _ _) = "typeClass"++data ChildDeclaration = ChildDeclaration+  { cdeclTitle      :: String+  , cdeclComments   :: Maybe String+  , cdeclSourceSpan :: Maybe P.SourceSpan+  , cdeclInfo       :: ChildDeclarationInfo+  }+  deriving (Show, Eq, Ord)++data ChildDeclarationInfo+  -- |+  -- A type instance declaration, with its dependencies and its type.+  --+  = ChildInstance [P.Constraint] P.Type++  -- |+  -- A data constructor, with its type arguments.+  --+  | ChildDataConstructor [P.Type]++  -- |+  -- A type class member, with its type. Note that the type does not include+  -- the type class constraint; this may be added manually if desired. For+  -- example, `pure` from `Applicative` would be `forall a. a -> f a`.+  --+  | ChildTypeClassMember P.Type+  deriving (Show, Eq, Ord)++childDeclInfoToString :: ChildDeclarationInfo -> String+childDeclInfoToString (ChildInstance _ _)      = "instance"+childDeclInfoToString (ChildDataConstructor _) = "dataConstructor"+childDeclInfoToString (ChildTypeClassMember _) = "typeClassMember"++newtype GithubUser+  = GithubUser { runGithubUser :: String }+  deriving (Show, Eq, Ord)++newtype GithubRepo+  = GithubRepo { runGithubRepo :: String }+  deriving (Show, Eq, Ord)++data PackageError+  = ErrorInPackageMeta BowerError+  | InvalidVersion+  | InvalidDeclarationType String+  | InvalidChildDeclarationType String+  | InvalidFixity+  | InvalidKind String+  | InvalidDataDeclType String+  deriving (Show, Eq, Ord)++type Bookmark = InPackage (P.ModuleName, String)++data InPackage a+  = Local a+  | FromDep PackageName a+  deriving (Show, Eq, Ord)++instance Functor InPackage where+  fmap f (Local x) = Local (f x)+  fmap f (FromDep pkgName x) = FromDep pkgName (f x)++takeLocal :: InPackage a -> Maybe a+takeLocal (Local a) = Just a+takeLocal _ = Nothing++takeLocals :: [InPackage a] -> [a]+takeLocals = mapMaybe takeLocal++ignorePackage :: InPackage a -> a+ignorePackage (Local x) = x+ignorePackage (FromDep _ x) = x++----------------------+-- Parsing++parseUploadedPackage :: ByteString -> Either (ParseError PackageError) UploadedPackage+parseUploadedPackage = parse asUploadedPackage++parseVerifiedPackage :: ByteString -> Either (ParseError PackageError) VerifiedPackage+parseVerifiedPackage = parse asVerifiedPackage++asPackage :: (forall e. Parse e a) -> Parse PackageError (Package a)+asPackage uploader =+  Package <$> key "packageMeta" asPackageMeta .! ErrorInPackageMeta+          <*> key "version" asVersion+          <*> key "versionTag" asString+          <*> key "modules" (eachInArray asModule)+          <*> key "bookmarks" asBookmarks .! ErrorInPackageMeta+          <*> key "resolvedDependencies" asResolvedDependencies+          <*> key "github" asGithub+          <*> key "uploader" uploader++asUploadedPackage :: Parse PackageError UploadedPackage+asUploadedPackage = asPackage asNotYetKnown++asNotYetKnown :: Parse e NotYetKnown+asNotYetKnown = NotYetKnown <$ asNull++instance A.FromJSON NotYetKnown where+  parseJSON = toAesonParser' asNotYetKnown++asVerifiedPackage :: Parse PackageError VerifiedPackage+asVerifiedPackage = asPackage asGithubUser++asGithubUser :: Parse e GithubUser+asGithubUser = GithubUser <$> asString++instance A.FromJSON GithubUser where+  parseJSON = toAesonParser' asGithubUser++instance A.FromJSON a => A.FromJSON (Package a) where+  -- TODO: actual error display+  parseJSON = toAesonParser (T.pack . show)+                            (asPackage fromAesonParser)++asVersion :: Parse PackageError Version+asVersion = withString (maybe (Left InvalidVersion) Right . parseVersion')++parseVersion' :: String -> Maybe Version+parseVersion' str =+  case filter (null . snd) $ readP_to_S parseVersion str of+    [(vers, "")] -> Just vers+    _            -> Nothing++asModule :: Parse PackageError Module+asModule =+  Module <$> key "name" asString+         <*> key "comments" (perhaps asString)+         <*> key "declarations" (eachInArray asDeclaration)++asDeclaration :: Parse PackageError Declaration+asDeclaration =+  Declaration <$> key "title" asString+              <*> key "comments" (perhaps asString)+              <*> key "sourceSpan" (perhaps asSourceSpan)+              <*> key "children" (eachInArray asChildDeclaration)+              <*> key "fixity" (perhaps asFixity)+              <*> key "info" asDeclarationInfo++asFixity :: Parse PackageError P.Fixity+asFixity = P.Fixity <$> key "associativity" asAssociativity+                    <*> key "precedence" asIntegral++parseAssociativity :: String -> Maybe P.Associativity+parseAssociativity str = case str of+  "infix"  -> Just P.Infix+  "infixl" -> Just P.Infixl+  "infixr" -> Just P.Infixr+  _        -> Nothing++asAssociativity :: Parse PackageError P.Associativity+asAssociativity = withString (maybe (Left InvalidFixity) Right . parseAssociativity)++asDeclarationInfo :: Parse PackageError DeclarationInfo+asDeclarationInfo = do+  ty <- key "declType" asString+  case ty of+    "value" ->+      ValueDeclaration <$> key "type" asType+    "data" ->+      DataDeclaration <$> key "dataDeclType" asDataDeclType+                      <*> key "typeArguments" asTypeArguments+    "externData" ->+      ExternDataDeclaration <$> key "kind" asKind+    "typeSynonym" ->+      TypeSynonymDeclaration <$> key "arguments" asTypeArguments+                             <*> key "type" asType+    "typeClass" ->+      TypeClassDeclaration <$> key "arguments" asTypeArguments+                           <*> key "superclasses" (eachInArray asConstraint)+    other ->+      throwCustomError (InvalidDeclarationType other)++asTypeArguments :: Parse PackageError [(String, Maybe P.Kind)]+asTypeArguments = eachInArray asTypeArgument+  where+  asTypeArgument = (,) <$> nth 0 asString <*> nth 1 (perhaps asKind)++asKind :: Parse e P.Kind+asKind = fromAesonParser++asType :: Parse e P.Type+asType = fromAesonParser++asDataDeclType :: Parse PackageError P.DataDeclType+asDataDeclType =+  withString $ \s -> case s of+    "data"    -> Right P.Data+    "newtype" -> Right P.Newtype+    other     -> Left (InvalidDataDeclType other)++asChildDeclaration :: Parse PackageError ChildDeclaration+asChildDeclaration =+  ChildDeclaration <$> key "title" asString+                           <*> key "comments" (perhaps asString)+                           <*> key "sourceSpan" (perhaps asSourceSpan)+                           <*> key "info" asChildDeclarationInfo++asChildDeclarationInfo :: Parse PackageError ChildDeclarationInfo+asChildDeclarationInfo = do+  ty <- key "declType" asString+  case ty of+    "instance" ->+      ChildInstance <$> key "dependencies" (eachInArray asConstraint)+                    <*> key "type" asType+    "dataConstructor" ->+      ChildDataConstructor <$> key "arguments" (eachInArray asType)+    "typeClassMember" ->+      ChildTypeClassMember <$> key "type" asType+    other ->+      throwCustomError $ InvalidChildDeclarationType other++asSourcePos :: Parse e P.SourcePos+asSourcePos = P.SourcePos <$> nth 0 asIntegral+                          <*> nth 1 asIntegral++asConstraint :: Parse PackageError P.Constraint+asConstraint = (,) <$> nth 0 asQualifiedProperName+                   <*> nth 1 (eachInArray asType)++asQualifiedProperName :: Parse e (P.Qualified P.ProperName)+asQualifiedProperName = fromAesonParser++asBookmarks :: Parse BowerError [Bookmark]+asBookmarks = eachInArray asBookmark++asBookmark :: Parse BowerError Bookmark+asBookmark =+  build <$> key "package" (perhaps (withString parsePackageName))+        <*> key "item" ((,) <$> nth 0 (P.moduleNameFromString <$> asString)+                            <*> nth 1 asString)+  where+  build Nothing = Local+  build (Just pn) = FromDep pn++asResolvedDependencies :: Parse PackageError [(PackageName, Version)]+asResolvedDependencies =+  eachInObjectWithKey (mapLeft ErrorInPackageMeta . parsePackageName . T.unpack) asVersion+  where+  mapLeft f (Left x) = Left (f x)+  mapLeft _ (Right x) = Right x++asGithub :: Parse e (GithubUser, GithubRepo)+asGithub = (,) <$> nth 0 (GithubUser <$> asString)+               <*> nth 1 (GithubRepo <$> asString)++asSourceSpan :: Parse e P.SourceSpan+asSourceSpan = P.SourceSpan <$> key "name" asString+                            <*> key "start" asSourcePos+                            <*> key "end" asSourcePos++---------------------+-- ToJSON instances++instance A.ToJSON a => A.ToJSON (Package a) where+  toJSON Package{..} =+    A.object $+      [ "packageMeta"          .= pkgMeta+      , "version"              .= showVersion pkgVersion+      , "versionTag"           .= pkgVersionTag+      , "modules"              .= pkgModules+      , "bookmarks"            .= map (fmap (first P.runModuleName)) pkgBookmarks+      , "resolvedDependencies" .= assocListToJSON (T.pack . runPackageName)+                                                  (T.pack . showVersion)+                                                  pkgResolvedDependencies+      , "github"               .= pkgGithub+      , "uploader"             .= pkgUploader+      ]++instance A.ToJSON NotYetKnown where+  toJSON _ = A.Null++instance A.ToJSON Module where+  toJSON Module{..} =+    A.object [ "name"         .= modName+             , "comments"     .= modComments+             , "declarations" .= modDeclarations+             ]++instance A.ToJSON Declaration where+  toJSON Declaration{..} =+    A.object [ "title"      .= declTitle+             , "comments"   .= declComments+             , "sourceSpan" .= declSourceSpan+             , "children"   .= declChildren+             , "fixity"     .= declFixity+             , "info"       .= declInfo+             ]++instance A.ToJSON ChildDeclaration where+  toJSON ChildDeclaration{..} =+    A.object [ "title"      .= cdeclTitle+             , "comments"   .= cdeclComments+             , "sourceSpan" .= cdeclSourceSpan+             , "info"       .= cdeclInfo+             ]++instance A.ToJSON DeclarationInfo where+  toJSON info = A.object $ "declType" .= declInfoToString info : props+    where+    props = case info of+      ValueDeclaration ty -> ["type" .= ty]+      DataDeclaration ty args -> ["dataDeclType" .= ty, "typeArguments" .= args]+      ExternDataDeclaration kind -> ["kind" .= kind]+      TypeSynonymDeclaration args ty -> ["arguments" .= args, "type" .= ty]+      TypeClassDeclaration args super -> ["arguments" .= args, "superclasses" .= super]++instance A.ToJSON ChildDeclarationInfo where+  toJSON info = A.object $ "declType" .= childDeclInfoToString info : props+    where+    props = case info of+      ChildInstance deps ty     -> ["dependencies" .= deps, "type" .= ty]+      ChildDataConstructor args -> ["arguments" .= args]+      ChildTypeClassMember ty   -> ["type" .= ty]++instance A.ToJSON GithubUser where+  toJSON = A.toJSON . runGithubUser++instance A.ToJSON GithubRepo where+  toJSON = A.toJSON . runGithubRepo++-- | Given a function for turning association list keys into JSON object keys,+-- and a function for turning association list values to JSON string values,+-- turns an association list into a JSON object.+--+-- For example:+-- @assocListToJSON T.pack T.pack [("a", "b")]@ will give @{"a": "b"}@.+assocListToJSON :: (a -> Text) -> (b -> Text) -> [(a, b)] -> A.Value+assocListToJSON f g xs = A.object (map (uncurry (.=) . (f *** g)) xs)++instance A.ToJSON a => A.ToJSON (InPackage a) where+  toJSON x =+    case x of+      Local y      -> withPackage (Nothing :: Maybe ()) y+      FromDep pn y -> withPackage (Just pn) y+    where+    withPackage :: (A.ToJSON p, A.ToJSON x) => p -> x -> A.Value+    withPackage p y =+      A.object [ "package" .= p+               , "item"    .= y+               ]

+ src/Language/PureScript/Docs/Utils/MonoidExtras.hs view

@@ -0,0 +1,9 @@+module Language.PureScript.Docs.Utils.MonoidExtras where++import Data.Monoid++mintersperse :: (Monoid m) => m -> [m] -> m+mintersperse _ []       = mempty+mintersperse _ [x]      = x+mintersperse sep (x:xs) = x <> sep <> mintersperse sep xs+

src/Language/PureScript/Environment.hs view

@@ -13,12 +13,15 @@ -----------------------------------------------------------------------------  {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}  module Language.PureScript.Environment where  import Data.Data import Data.Maybe (fromMaybe) import qualified Data.Map as M+import qualified Data.Text as T+import qualified Data.Aeson as A  import Language.PureScript.Kinds import Language.PureScript.Names@@ -49,7 +52,7 @@   -- |   -- Available type class dictionaries   ---  , typeClassDictionaries :: M.Map (Qualified Ident, Maybe ModuleName) TypeClassDictionaryInScope+  , typeClassDictionaries :: M.Map (Maybe ModuleName) (M.Map (Qualified ProperName) (M.Map (Qualified Ident) TypeClassDictionaryInScope))   -- |   -- Type classes   --@@ -63,19 +66,6 @@ initEnvironment = Environment M.empty primTypes M.empty M.empty M.empty M.empty  -- |--- The type of a foreign import----data ForeignImportType-  -- |-  -- A regular foreign import-  ---  = ForeignImport-  -- |-  -- A foreign import which contains inline Javascript as a string literal-  ---  | InlineJavascript deriving (Show, Eq, Data, Typeable)---- | -- The visibility of a name in scope -- data NameVisibility@@ -89,33 +79,23 @@   | Defined deriving (Show, Eq)  -- |--- The kind of a name+-- 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   -- |-  -- A value introduced as a binding in a module-  ---  = Value-  -- |-  -- A type class dictionary member accessor import, generated during desugaring of type class declarations-  ---  | TypeClassAccessorImport-  -- |-  -- A foreign import-  ---  | Extern ForeignImportType-  -- |-  -- A local name introduced using a lambda abstraction, variable introduction or binder+  -- A private value introduced as an artifact of code generation (class instances, class member+  -- accessors, etc.)   ---  | LocalVariable+  = Private   -- |-  -- A data constructor+  -- A public value for a module member or foreing import declaration   ---  | DataConstructor+  | Public   -- |-  -- A type class dictionary, generated during desugaring of type class declarations+  -- A name for member introduced by foreign import   ---  | TypeInstanceDictionaryValue deriving (Show, Eq, Data, Typeable)+  | External deriving (Show, Eq, Data, Typeable)  -- | -- The kinds of a type@@ -160,6 +140,16 @@   show Data = "data"   show Newtype = "newtype" +instance A.ToJSON DataDeclType where+  toJSON = A.toJSON . show++instance A.FromJSON DataDeclType where+  parseJSON = A.withText "DataDeclType" $ \str ->+    case str of+      "data" -> return Data+      "newtype" -> return Newtype+      other -> fail $ "invalid type: '" ++ T.unpack other ++ "'"+ -- | -- Construct a ProperName in the Prim module --@@ -185,12 +175,24 @@ tyString = primTy "String"  -- |+-- Type constructor for strings+--+tyChar :: Type+tyChar = primTy "Char"++-- | -- Type constructor for numbers -- tyNumber :: Type tyNumber = primTy "Number"  -- |+-- Type constructor for integers+--+tyInt :: Type+tyInt = primTy "Int"++-- | -- Type constructor for booleans -- tyBoolean :: Type@@ -209,6 +211,14 @@ tyObject = primTy "Object"  -- |+-- Check whether a type is an object+--+isObject :: Type -> Bool+isObject = (==) tyObject . extract+  where extract (TypeApp t _) = t+        extract t = t++-- | -- Smart constructor for function types -- function :: Type -> Type -> Type@@ -222,7 +232,9 @@                        , (primName "Array"    , (FunKind Star Star, ExternData))                        , (primName "Object"   , (FunKind (Row Star) Star, ExternData))                        , (primName "String"   , (Star, ExternData))+                       , (primName "Char"     , (Star, ExternData))                        , (primName "Number"   , (Star, ExternData))+                       , (primName "Int"      , (Star, ExternData))                        , (primName "Boolean"  , (Star, ExternData)) ]  -- |@@ -239,3 +251,10 @@ isNewtypeConstructor e ctor = case lookupConstructor e ctor of   (Newtype, _, _, _) -> True   (Data, _, _, _) -> False++-- |+-- Finds information about values from the current environment.+--+lookupValue :: Environment -> Qualified Ident -> Maybe (Type, NameKind, NameVisibility)+lookupValue env (Qualified (Just mn) ident) = (mn, ident) `M.lookup` names env+lookupValue _ _ = Nothing

src/Language/PureScript/Errors.hs view

@@ -20,14 +20,22 @@  import Data.Either (lefts, rights) import Data.List (intercalate)+import Data.Function (on) import Data.Monoid import Data.Foldable (fold, foldMap) -import Control.Monad.Except+import qualified Data.Map as M++import Control.Monad import Control.Monad.Unify-import Control.Applicative ((<$>))+import Control.Monad.Writer+import Control.Monad.Error.Class (MonadError(..))+import Control.Applicative ((<$>), (<*>), Applicative, pure)+import Control.Monad.Trans.State.Lazy+import Control.Arrow(first)  import Language.PureScript.AST+import Language.PureScript.Environment (isObject) import Language.PureScript.Pretty import Language.PureScript.Types import Language.PureScript.Names@@ -36,11 +44,23 @@  import qualified Text.PrettyPrint.Boxes as Box +import qualified Text.Parsec as P+ -- | -- A type of error messages ---data ErrorMessage -  = InfiniteType Type+data SimpleErrorMessage+  = ErrorParsingExterns P.ParseError+  | ErrorParsingFFIModule FilePath+  | ErrorParsingModule P.ParseError+  | MissingFFIModule ModuleName+  | MultipleFFIModules ModuleName [FilePath]+  | UnnecessaryFFIModule ModuleName FilePath+  | InvalidExternsFile FilePath+  | CannotGetFileInfo FilePath+  | CannotReadFile FilePath+  | CannotWriteFile FilePath+  | InfiniteType Type   | InfiniteKind Kind   | CannotReorderOperators   | MultipleFixities Ident@@ -56,7 +76,7 @@   | UnknownDataConstructor (Qualified ProperName) (Maybe (Qualified ProperName))   | UnknownTypeConstructor (Qualified ProperName)   | ConflictingImport String ModuleName-  | ConflictingImports String ModuleName ModuleName  +  | ConflictingImports String ModuleName ModuleName   | ConflictingTypeDecls ProperName   | ConflictingCtorDecls ProperName   | TypeConflictsWithClass ProperName@@ -70,11 +90,11 @@   | InvalidDoLet   | CycleInDeclaration Ident   | CycleInTypeSynonym (Maybe ProperName)+  | CycleInModules [ModuleName]   | NameIsUndefined Ident   | NameNotInScope Ident   | UndefinedTypeVariable ProperName   | PartiallyAppliedSynonym (Qualified ProperName)-  | NotYetDefined [Ident] ErrorMessage   | EscapedSkolem (Maybe Expr)   | UnspecifiedSkolemScope   | TypesDoNotUnify Type Type@@ -87,17 +107,28 @@   | ArgListLengthsDiffer Ident   | OverlappingArgNames (Maybe Ident)   | MissingClassMember Ident+  | ExtraneousClassMember Ident   | ExpectedType Kind   | IncorrectConstructorArity (Qualified ProperName)   | SubsumptionCheckFailed   | ExprDoesNotHaveType Expr Type   | PropertyIsMissing String Type-  | ErrorUnifyingTypes Type Type ErrorMessage   | CannotApplyFunction Type Expr   | TypeSynonymInstance   | InvalidNewtype   | InvalidInstanceHead Type   | TransitiveExportError DeclarationRef [DeclarationRef]+  | ShadowedName Ident+  | WildcardInferredType Type+  | ClassOperator ProperName Ident+  deriving (Show)++-- |+-- Wrapper of simpler errors+--+data ErrorMessage+  = NotYetDefined [Ident] ErrorMessage+  | ErrorUnifyingTypes Type Type ErrorMessage   | ErrorInExpression Expr ErrorMessage   | ErrorInModule ModuleName ErrorMessage   | ErrorInInstance (Qualified ProperName) [Type] ErrorMessage@@ -114,110 +145,120 @@   | ErrorInValueDeclaration Ident ErrorMessage   | ErrorInForeignImport Ident ErrorMessage   | PositionedError SourceSpan ErrorMessage+  | SimpleErrorWrapper SimpleErrorMessage   deriving (Show)-  + instance UnificationError Type ErrorMessage where-  occursCheckFailed = InfiniteType-  +  occursCheckFailed t = SimpleErrorWrapper $ InfiniteType t+ instance UnificationError Kind ErrorMessage where-  occursCheckFailed = InfiniteKind+  occursCheckFailed k = SimpleErrorWrapper $ InfiniteKind k  -- | -- Get the error code for a particular error type -- errorCode :: ErrorMessage -> String-errorCode (InfiniteType _)              = "InfiniteType"-errorCode (InfiniteKind _)              = "InfiniteKind"-errorCode CannotReorderOperators        = "CannotReorderOperators"-errorCode (MultipleFixities _)          = "MultipleFixities"-errorCode (OrphanTypeDeclaration _)     = "OrphanTypeDeclaration"-errorCode (OrphanFixityDeclaration _)   = "OrphanFixityDeclaration"-errorCode (RedefinedModule _)           = "RedefinedModule"-errorCode (RedefinedIdent _)            = "RedefinedIdent"-errorCode OverlappingNamesInLet         = "OverlappingNamesInLet"-errorCode (UnknownModule _)             = "UnknownModule"-errorCode (UnknownType _)               = "UnknownType"-errorCode (UnknownTypeClass _)          = "UnknownTypeClass"-errorCode (UnknownValue _)              = "UnknownValue"-errorCode (UnknownDataConstructor _ _)  = "UnknownDataConstructor"-errorCode (UnknownTypeConstructor _)    = "UnknownTypeConstructor"-errorCode (ConflictingImport _ _)       = "ConflictingImport"-errorCode (ConflictingImports _ _ _)    = "ConflictingImports"-errorCode (ConflictingTypeDecls _)      = "ConflictingTypeDecls"-errorCode (ConflictingCtorDecls _)      = "ConflictingCtorDecls"-errorCode (TypeConflictsWithClass _)    = "TypeConflictsWithClass"-errorCode (CtorConflictsWithClass _)    = "CtorConflictsWithClass"-errorCode (ClassConflictsWithType _)    = "ClassConflictsWithType"-errorCode (ClassConflictsWithCtor _)    = "ClassConflictsWithCtor"-errorCode (DuplicateClassExport _)      = "DuplicateClassExport"-errorCode (DuplicateValueExport _)      = "DuplicateValueExport"-errorCode (DuplicateTypeArgument _)     = "DuplicateTypeArgument"-errorCode InvalidDoBind                 = "InvalidDoBind"-errorCode InvalidDoLet                  = "InvalidDoLet"-errorCode (CycleInDeclaration _)        = "CycleInDeclaration"-errorCode (CycleInTypeSynonym _)        = "CycleInTypeSynonym"-errorCode (NameIsUndefined _)           = "NameIsUndefined"-errorCode (NameNotInScope _)            = "NameNotInScope"-errorCode (UndefinedTypeVariable _)     = "UndefinedTypeVariable"-errorCode (PartiallyAppliedSynonym _)   = "PartiallyAppliedSynonym"-errorCode (EscapedSkolem _)             = "EscapedSkolem"-errorCode UnspecifiedSkolemScope        = "UnspecifiedSkolemScope"-errorCode (TypesDoNotUnify _ _)         = "TypesDoNotUnify"-errorCode (KindsDoNotUnify _ _)         = "KindsDoNotUnify"-errorCode (ConstrainedTypeUnified _ _)  = "ConstrainedTypeUnified"-errorCode (OverlappingInstances _ _ _)  = "OverlappingInstances"-errorCode (NoInstanceFound _ _)         = "NoInstanceFound"-errorCode (DuplicateLabel _ _)          = "DuplicateLabel"-errorCode (DuplicateValueDeclaration _) = "DuplicateValueDeclaration"-errorCode (ArgListLengthsDiffer _)      = "ArgListLengthsDiffer"-errorCode (OverlappingArgNames _)       = "OverlappingArgNames"-errorCode (MissingClassMember _)        = "MissingClassMember"-errorCode (ExpectedType _)              = "ExpectedType"-errorCode (IncorrectConstructorArity _) = "IncorrectConstructorArity"-errorCode SubsumptionCheckFailed        = "SubsumptionCheckFailed"-errorCode (ExprDoesNotHaveType _ _)     = "ExprDoesNotHaveType"-errorCode (PropertyIsMissing _ _)       = "PropertyIsMissing"-errorCode (ErrorUnifyingTypes _ _ _)    = "ErrorUnifyingTypes"-errorCode (CannotApplyFunction _ _)     = "CannotApplyFunction"-errorCode TypeSynonymInstance           = "TypeSynonymInstance"-errorCode InvalidNewtype                = "InvalidNewtype"-errorCode (InvalidInstanceHead _)       = "InvalidInstanceHead"-errorCode (TransitiveExportError _ _)   = "TransitiveExportError"-errorCode (NotYetDefined _ e)           = errorCode e-errorCode (ErrorInExpression _ e)       = errorCode e-errorCode (ErrorInModule _ e)           = errorCode e-errorCode (ErrorInInstance _ _ e)       = errorCode e-errorCode (ErrorInSubsumption _ _ e)    = errorCode e-errorCode (ErrorCheckingType _ _ e)     = errorCode e-errorCode (ErrorCheckingKind _ e)       = errorCode e-errorCode (ErrorInferringType _ e)      = errorCode e-errorCode (ErrorInApplication _ _ _ e)  = errorCode e-errorCode (ErrorInDataConstructor _ e)  = errorCode e-errorCode (ErrorInTypeConstructor _ e)  = errorCode e-errorCode (ErrorInBindingGroup _ e)     = errorCode e-errorCode (ErrorInDataBindingGroup e)   = errorCode e-errorCode (ErrorInTypeSynonym _ e)      = errorCode e-errorCode (ErrorInValueDeclaration _ e) = errorCode e-errorCode (ErrorInForeignImport _ e)    = errorCode e-errorCode (PositionedError _ e)         = errorCode e-  +errorCode em = case unwrapErrorMessage em of+  (ErrorParsingExterns _)       -> "ErrorParsingExterns"+  (ErrorParsingFFIModule _)     -> "ErrorParsingFFIModule"+  (ErrorParsingModule _)        -> "ErrorParsingModule"+  MissingFFIModule{}            -> "MissingFFIModule"+  MultipleFFIModules{}          -> "MultipleFFIModules"+  UnnecessaryFFIModule{}        -> "UnnecessaryFFIModule"+  (InvalidExternsFile _)        -> "InvalidExternsFile"+  (CannotGetFileInfo _)         -> "CannotGetFileInfo"+  (CannotReadFile _)            -> "CannotReadFile"+  (CannotWriteFile _)           -> "CannotWriteFile"+  (InfiniteType _)              -> "InfiniteType"+  (InfiniteKind _)              -> "InfiniteKind"+  CannotReorderOperators        -> "CannotReorderOperators"+  (MultipleFixities _)          -> "MultipleFixities"+  (OrphanTypeDeclaration _)     -> "OrphanTypeDeclaration"+  (OrphanFixityDeclaration _)   -> "OrphanFixityDeclaration"+  (RedefinedModule _)           -> "RedefinedModule"+  (RedefinedIdent _)            -> "RedefinedIdent"+  OverlappingNamesInLet         -> "OverlappingNamesInLet"+  (UnknownModule _)             -> "UnknownModule"+  (UnknownType _)               -> "UnknownType"+  (UnknownTypeClass _)          -> "UnknownTypeClass"+  (UnknownValue _)              -> "UnknownValue"+  (UnknownDataConstructor _ _)  -> "UnknownDataConstructor"+  (UnknownTypeConstructor _)    -> "UnknownTypeConstructor"+  (ConflictingImport _ _)       -> "ConflictingImport"+  (ConflictingImports _ _ _)    -> "ConflictingImports"+  (ConflictingTypeDecls _)      -> "ConflictingTypeDecls"+  (ConflictingCtorDecls _)      -> "ConflictingCtorDecls"+  (TypeConflictsWithClass _)    -> "TypeConflictsWithClass"+  (CtorConflictsWithClass _)    -> "CtorConflictsWithClass"+  (ClassConflictsWithType _)    -> "ClassConflictsWithType"+  (ClassConflictsWithCtor _)    -> "ClassConflictsWithCtor"+  (DuplicateClassExport _)      -> "DuplicateClassExport"+  (DuplicateValueExport _)      -> "DuplicateValueExport"+  (DuplicateTypeArgument _)     -> "DuplicateTypeArgument"+  InvalidDoBind                 -> "InvalidDoBind"+  InvalidDoLet                  -> "InvalidDoLet"+  (CycleInDeclaration _)        -> "CycleInDeclaration"+  (CycleInTypeSynonym _)        -> "CycleInTypeSynonym"+  (CycleInModules _)            -> "CycleInModules"+  (NameIsUndefined _)           -> "NameIsUndefined"+  (NameNotInScope _)            -> "NameNotInScope"+  (UndefinedTypeVariable _)     -> "UndefinedTypeVariable"+  (PartiallyAppliedSynonym _)   -> "PartiallyAppliedSynonym"+  (EscapedSkolem _)             -> "EscapedSkolem"+  UnspecifiedSkolemScope        -> "UnspecifiedSkolemScope"+  (TypesDoNotUnify _ _)         -> "TypesDoNotUnify"+  (KindsDoNotUnify _ _)         -> "KindsDoNotUnify"+  (ConstrainedTypeUnified _ _)  -> "ConstrainedTypeUnified"+  (OverlappingInstances _ _ _)  -> "OverlappingInstances"+  (NoInstanceFound _ _)         -> "NoInstanceFound"+  (DuplicateLabel _ _)          -> "DuplicateLabel"+  (DuplicateValueDeclaration _) -> "DuplicateValueDeclaration"+  (ArgListLengthsDiffer _)      -> "ArgListLengthsDiffer"+  (OverlappingArgNames _)       -> "OverlappingArgNames"+  (MissingClassMember _)        -> "MissingClassMember"+  (ExtraneousClassMember _)     -> "ExtraneousClassMember"+  (ExpectedType _)              -> "ExpectedType"+  (IncorrectConstructorArity _) -> "IncorrectConstructorArity"+  SubsumptionCheckFailed        -> "SubsumptionCheckFailed"+  (ExprDoesNotHaveType _ _)     -> "ExprDoesNotHaveType"+  (PropertyIsMissing _ _)       -> "PropertyIsMissing"+  (CannotApplyFunction _ _)     -> "CannotApplyFunction"+  TypeSynonymInstance           -> "TypeSynonymInstance"+  InvalidNewtype                -> "InvalidNewtype"+  (InvalidInstanceHead _)       -> "InvalidInstanceHead"+  (TransitiveExportError _ _)   -> "TransitiveExportError"+  (ShadowedName _)              -> "ShadowedName"+  (WildcardInferredType _)      -> "WildcardInferredType"+  (ClassOperator _ _)           -> "ClassOperator"+ -- | -- A stack trace for an error ---newtype MultipleErrors = MultipleErrors +newtype MultipleErrors = MultipleErrors   { runMultipleErrors :: [ErrorMessage] } deriving (Show, Monoid)-  + instance UnificationError Type MultipleErrors where-  occursCheckFailed = errorMessage . occursCheckFailed-  +  occursCheckFailed = occursCheckFailed+ instance UnificationError Kind MultipleErrors where-  occursCheckFailed = errorMessage . occursCheckFailed+  occursCheckFailed = occursCheckFailed +-- | Check whether a collection of errors is empty or not.+nonEmpty :: MultipleErrors -> Bool+nonEmpty = not . null . runMultipleErrors+ -- |+-- Create an error set from a single simple error message+--+errorMessage :: SimpleErrorMessage -> MultipleErrors+errorMessage err = MultipleErrors [SimpleErrorWrapper err]+++-- | -- Create an error set from a single error message ---errorMessage :: ErrorMessage -> MultipleErrors-errorMessage err = MultipleErrors [err]+singleError :: ErrorMessage -> MultipleErrors+singleError = MultipleErrors . pure  -- | -- Lift a function on ErrorMessage to a function on MultipleErrors@@ -225,192 +266,401 @@ onErrorMessages :: (ErrorMessage -> ErrorMessage) -> MultipleErrors -> MultipleErrors onErrorMessages f = MultipleErrors . map f . runMultipleErrors +-- | The various types of things which might need to be relabelled in errors messages.+data LabelType = TypeLabel | SkolemLabel String deriving (Show, Eq, Ord)++-- | A map from rigid type variable name/unknown variable pairs to new variables.+type UnknownMap = M.Map (LabelType, Unknown) Unknown+ -- |--- Pretty print a single error, simplifying if necessary+-- Extract nested error messages from wrapper errors ---prettyPrintSingleError :: Bool -> ErrorMessage -> Box.Box-prettyPrintSingleError full e = prettyPrintErrorMessage (if full then e else simplifyErrorMessage e)+unwrapErrorMessage :: ErrorMessage -> SimpleErrorMessage+unwrapErrorMessage em = case em of+  (ErrorCheckingKind _ err)       -> unwrapErrorMessage err+  (ErrorCheckingType _ _ err)     -> unwrapErrorMessage err+  (ErrorInApplication _ _ _ err)  -> unwrapErrorMessage err+  (ErrorInBindingGroup _ err)     -> unwrapErrorMessage err+  (ErrorInDataBindingGroup err)   -> unwrapErrorMessage err+  (ErrorInDataConstructor _ err)  -> unwrapErrorMessage err+  (ErrorInExpression _ err)       -> unwrapErrorMessage err+  (ErrorInForeignImport _ err)    -> unwrapErrorMessage err+  (ErrorInInstance _ _ err)       -> unwrapErrorMessage err+  (ErrorInModule _ err)           -> unwrapErrorMessage err+  (ErrorInSubsumption _ _ err)    -> unwrapErrorMessage err+  (ErrorInTypeConstructor _ err)  -> unwrapErrorMessage err+  (ErrorInTypeSynonym _ err)      -> unwrapErrorMessage err+  (ErrorInValueDeclaration _ err) -> unwrapErrorMessage err+  (ErrorInferringType _ err)      -> unwrapErrorMessage err+  (ErrorUnifyingTypes _ _ err)    -> unwrapErrorMessage err+  (NotYetDefined _ err)           -> unwrapErrorMessage err+  (PositionedError _ err)         -> unwrapErrorMessage err+  (SimpleErrorWrapper sem)        -> sem++replaceUnknowns :: Type -> State UnknownMap Type+replaceUnknowns = everywhereOnTypesM replaceTypes   where+  lookupTable :: (LabelType, Unknown) -> UnknownMap -> (Unknown, UnknownMap)+  lookupTable x m = case M.lookup x m of+                      Nothing -> let i = length (filter (on (==) fst x) (M.keys m)) in (i, M.insert x i m)+                      Just i  -> (i, m)++  replaceTypes :: Type -> State UnknownMap Type+  replaceTypes (TUnknown u) = state $ first TUnknown . lookupTable (TypeLabel, u)+  replaceTypes (Skolem name s sko) = state $ first (flip (Skolem name) sko) . lookupTable (SkolemLabel name, s)+  replaceTypes other = return other++onTypesInErrorMessageM :: (Applicative m) => (Type -> m Type) -> ErrorMessage -> m ErrorMessage+onTypesInErrorMessageM f = g+  where+    gSimple (InfiniteType t) = InfiniteType <$> (f t)+    gSimple (TypesDoNotUnify t1 t2) = TypesDoNotUnify <$> (f t1) <*> (f t2)+    gSimple (ConstrainedTypeUnified t1 t2) = ConstrainedTypeUnified <$> (f t1) <*> (f t2)+    gSimple (ExprDoesNotHaveType e t) = ExprDoesNotHaveType e <$> (f t)+    gSimple (PropertyIsMissing s t) = PropertyIsMissing s <$> (f t)+    gSimple (CannotApplyFunction t e) = CannotApplyFunction <$> f t <*> (pure e)+    gSimple (InvalidInstanceHead t) = InvalidInstanceHead <$> f t+    gSimple other = pure other+    g (ErrorInSubsumption t1 t2 em) = ErrorInSubsumption <$> (f t1) <*> (f t2) <*> (g em)+    g (ErrorUnifyingTypes t1 t2 e) = ErrorUnifyingTypes <$> (f t1) <*> (f t2) <*> (g e)+    g (ErrorCheckingType e t em) = ErrorCheckingType e <$> (f t) <*> (g em)+    g (ErrorCheckingKind t em) = ErrorCheckingKind <$> (f t) <*> g em+    g (ErrorInApplication e1 t1 e2 em) = ErrorInApplication e1 <$> (f t1) <*> (pure e2) <*> (g em)+    g (NotYetDefined x e) = NotYetDefined x <$> (g e)+    g (ErrorInExpression x e) = ErrorInExpression x <$> (g e)+    g (ErrorInModule x e) = ErrorInModule x <$> (g e)+    g (ErrorInInstance x y e) = ErrorInInstance x y <$> (g e)+    g (ErrorInferringType x e) = ErrorInferringType x <$> (g e)+    g (ErrorInDataConstructor x e) = ErrorInDataConstructor x <$> (g e)+    g (ErrorInTypeConstructor x e) = ErrorInTypeConstructor x <$> (g e)+    g (ErrorInBindingGroup x e) = ErrorInBindingGroup x <$> (g e)+    g (ErrorInDataBindingGroup e) = ErrorInDataBindingGroup <$> (g e)+    g (ErrorInTypeSynonym x e) = ErrorInTypeSynonym x <$> (g e)+    g (ErrorInValueDeclaration x e) = ErrorInValueDeclaration x <$> (g e)+    g (ErrorInForeignImport x e) = ErrorInForeignImport x <$> (g e)+    g (PositionedError x e) = PositionedError x <$> (g e)+    g (SimpleErrorWrapper sem) = SimpleErrorWrapper <$> gSimple sem++-- |+-- Pretty print a single error, simplifying if necessary+--+prettyPrintSingleError :: Bool -> ErrorMessage -> State UnknownMap Box.Box+prettyPrintSingleError full e = prettyPrintErrorMessage <$> onTypesInErrorMessageM replaceUnknowns (if full then e else simplifyErrorMessage e)+ where   -- |   -- Pretty print an ErrorMessage   --   prettyPrintErrorMessage :: ErrorMessage -> Box.Box   prettyPrintErrorMessage em =-    paras-      [ go em-      , line ("See " ++ wikiUri ++ " for more information, or to contribute content related to this error.") -      ]+    paras $+      go em:suggestions em +++      [line $ "See " ++ wikiUri ++ " for more information, or to contribute content related to this error."]     where     wikiUri :: String     wikiUri = "https://github.com/purescript/purescript/wiki/Error-Code-" ++ errorCode e-      +     go :: ErrorMessage -> Box.Box-    go InvalidDoBind                   = line "Bind statement cannot be the last statement in a do block"-    go InvalidDoLet                    = line "Let statement cannot be the last statement in a do block"-    go CannotReorderOperators          = line "Unable to reorder operators"-    go UnspecifiedSkolemScope          = line "Skolem variable scope is unspecified"-    go OverlappingNamesInLet           = line "Overlapping names in let binding."-    go (InfiniteType ty)               = paras [ line "Infinite type detected: "-                                               , indent $ line $ prettyPrintType ty-                                               ]-    go (InfiniteKind ki)               = paras [ line "Infinite kind detected: "-                                               , indent $ line $ prettyPrintKind ki-                                               ]-    go (MultipleFixities name)         = line $ "Multiple fixity declarations for " ++ show name-    go (OrphanTypeDeclaration nm)      = line $ "Orphan type declaration for " ++ show nm-    go (OrphanFixityDeclaration op)    = line $ "Orphan fixity declaration for " ++ show op-    go (RedefinedModule name)          = line $ "Module " ++ show name ++ " has been defined multiple times"-    go (RedefinedIdent name)           = line $ "Name " ++ show name ++ " has been defined multiple times"-    go (UnknownModule mn)              = line $ "Unknown module " ++ show mn-    go (UnknownType name)              = line $ "Unknown type " ++ show name-    go (UnknownTypeClass name)         = line $ "Unknown type class " ++ show name-    go (UnknownValue name)             = line $ "Unknown value " ++ show name-    go (UnknownTypeConstructor name)   = line $ "Unknown type constructor " ++ show name-    go (UnknownDataConstructor dc tc)  = line $ "Unknown data constructor " ++ show dc ++ foldMap ((" for type constructor " ++) . show) tc-    go (ConflictingImport nm mn)       = line $ "Declaration " ++ nm ++ " conflicts with import " ++ show mn -    go (ConflictingImports nm m1 m2)   = line $ "Conflicting imports for " ++ nm ++ " from modules " ++ show m1 ++ " and " ++ show m2-    go (ConflictingTypeDecls nm)       = line $ "Conflicting type declarations for " ++ show nm-    go (ConflictingCtorDecls nm)       = line $ "Conflicting data constructor declarations for " ++ show nm-    go (TypeConflictsWithClass nm)     = line $ "Type " ++ show nm ++ " conflicts with type class declaration of the same name"-    go (CtorConflictsWithClass nm)     = line $ "Data constructor " ++ show nm ++ " conflicts with type class declaration of the same name"-    go (ClassConflictsWithType nm)     = line $ "Type class " ++ show nm ++ " conflicts with type declaration of the same name"-    go (ClassConflictsWithCtor nm)     = line $ "Type class " ++ show nm ++ " conflicts with data constructor declaration of the same name"-    go (DuplicateClassExport nm)       = line $ "Duplicate export declaration for type class " ++ show nm-    go (DuplicateValueExport nm)       = line $ "Duplicate export declaration for value " ++ show nm-    go (CycleInDeclaration nm)         = line $ "Cycle in declaration of " ++ show nm-    go (NotYetDefined names err)       = paras [ line $ "The following are not yet defined here: " ++ intercalate ", " (map show names) ++ ":"-                                               , indent $ go err-                                               ]-    go (CycleInTypeSynonym pn)         = line $ "Cycle in type synonym" ++ foldMap ((" " ++) . show) pn-    go (NameIsUndefined ident)         = line $ show ident ++ " is undefined"-    go (NameNotInScope ident)          = line $ show ident ++ " may not be defined in the current scope"-    go (UndefinedTypeVariable name)    = line $ "Type variable " ++ show name ++ " is undefined"-    go (PartiallyAppliedSynonym name)  = line $ "Partially applied type synonym " ++ show name-    go (EscapedSkolem binding)         = paras $ [ line "Rigid/skolem type variable has escaped." ]-                                                 <> foldMap (\expr -> [ line "Relevant expression: "-                                                                      , indent $ line $ prettyPrintValue expr -                                                                      ]) binding-    go (TypesDoNotUnify t1 t2)         = paras [ line "Cannot unify type"-                                               , indent $ line $ prettyPrintType t1-                                               , line "with type"-                                               , indent $ line $ prettyPrintType t2-                                               ]-    go (KindsDoNotUnify k1 k2)         = paras [ line "Cannot unify kind"-                                               , indent $ line $ prettyPrintKind k1-                                               , line "with kind"-                                               , indent $ line $ prettyPrintKind k2-                                               ]-    go (ConstrainedTypeUnified t1 t2)  = paras [ line "Cannot unify constrained type"-                                               , indent $ line $ prettyPrintType t1-                                               , line "with type"-                                               , indent $ line $ prettyPrintType t2-                                               ]-    go (OverlappingInstances nm ts ds) = paras [ line $ "Overlapping instances found for " ++ show nm ++ " " ++ unwords (map prettyPrintTypeAtom ts) ++ ":"-                                               , paras $ map prettyPrintDictionaryValue ds-                                               ]-    go (NoInstanceFound nm ts)         = line $ "No instance found for " ++ show nm ++ " " ++ unwords (map prettyPrintTypeAtom ts)-    go (DuplicateLabel l expr)         = paras $ [ line $ "Duplicate label " ++ show l ++ " in row." ]-                                                 <> foldMap (\expr' -> [ line "Relevant expression: "-                                                                       , indent $ line $ prettyPrintValue expr' -                                                                       ]) expr-    go (DuplicateTypeArgument name)    = line $ "Duplicate type argument " ++ show name-    go (DuplicateValueDeclaration nm)  = line $ "Duplicate value declaration for " ++ show nm-    go (ArgListLengthsDiffer ident)    = line $ "Argument list lengths differ in declaration " ++ show ident-    go (OverlappingArgNames ident)     = line $ "Overlapping names in function/binder" ++ foldMap ((" in declaration" ++) . show) ident-    go (MissingClassMember ident)      = line $ "Member " ++ show ident ++ " has not been implemented"-    go (ExpectedType kind)             = line $ "Expected type of kind *, was " ++ prettyPrintKind kind-    go (IncorrectConstructorArity nm)  = line $ "Wrong number of arguments to constructor " ++ show nm-    go SubsumptionCheckFailed          = line $ "Unable to check type subsumption"-    go (ExprDoesNotHaveType expr ty)   = paras [ line "Expression"-                                               , indent $ line $ prettyPrintValue expr-                                               , line "does not have type"-                                               , indent $ line $ prettyPrintType ty-                                               ]-    go (PropertyIsMissing prop row)    = line $ "Row " ++ prettyPrintRow row ++ " lacks required property " ++ show prop-    go (CannotApplyFunction fn arg)    = paras [ line "Cannot apply function of type"-                                               , indent $ line $ prettyPrintType fn-                                               , line "to argument"-                                               , indent $ line $ prettyPrintValue arg-                                               ]-    go TypeSynonymInstance             = line "Type synonym instances are disallowed"-    go InvalidNewtype                  = line "Newtypes must define a single constructor with a single argument"-    go (InvalidInstanceHead ty)        = paras [ line "Invalid type in class instance head:"-                                               , indent $ line $ prettyPrintType ty-                                               ]-    go (TransitiveExportError x ys)    = paras $ (line $ "An export for " ++ prettyPrintExport x ++ " requires the following to also be exported: ")-                                                 : map (line . prettyPrintExport) ys-    go (ErrorUnifyingTypes t1 t2 err)  = paras [ line "Error unifying type "-                                               , indent $ line $ prettyPrintType t1-                                               , line "with type"-                                               , indent $ line $ prettyPrintType t2-                                               , go err-                                               ]-    go (ErrorInExpression expr err)    = paras [ line "Error in expression:"-                                               , indent $ line $ prettyPrintValue expr-                                               , go err-                                               ]-    go (ErrorInModule mn err)          = paras [ line $ "Error in module " ++ show mn ++ ":"-                                               , go err-                                               ]-    go (ErrorInSubsumption t1 t2 err)  = paras [ line "Error checking that type "-                                               , indent $ line $ prettyPrintType t1-                                               , line "subsumes type"-                                               , indent $ line $ prettyPrintType t2-                                               , go err-                                               ]-    go (ErrorInInstance name ts err)   = paras [ line $ "Error in type class instance " ++ show name ++ " " ++ unwords (map prettyPrintTypeAtom ts) ++ ":"-                                               , go err-                                               ]-    go (ErrorCheckingKind ty err)      = paras [ line "Error checking kind of type "-                                               , indent $ line $ prettyPrintType ty-                                               , go err-                                               ]-    go (ErrorInferringType expr err)   = paras [ line "Error inferring type of value "-                                               , indent $ line $ prettyPrintValue expr-                                               , go err-                                               ]-    go (ErrorCheckingType expr ty err) = paras [ line "Error checking that value "-                                               , indent $ line $ prettyPrintValue expr-                                               , line "has type"-                                               , indent $ line $ prettyPrintType ty-                                               , go err-                                               ]-    go (ErrorInApplication f t a err)  = paras [ line "Error applying function"-                                               , indent $ line $ prettyPrintValue f-                                               , line "of type"-                                               , indent $ line $ prettyPrintType t-                                               , line "to argument"-                                               , indent $ line $ prettyPrintValue a-                                               , go err-                                               ]-    go (ErrorInDataConstructor nm err) = paras [ line $ "Error in data constructor " ++ show nm ++ ":"-                                               , go err-                                               ]-    go (ErrorInTypeConstructor nm err) = paras [ line $ "Error in type constructor " ++ show nm ++ ":"-                                               , go err-                                               ]-    go (ErrorInBindingGroup nms err)   = paras [ line $ "Error in binding group " ++ intercalate ", " (map show nms) ++ ":"-                                               , go err-                                               ]-    go (ErrorInDataBindingGroup err)   = paras [ line $ "Error in data binding group:"-                                               , go err-                                               ]-    go (ErrorInTypeSynonym name err)   = paras [ line $ "Error in type synonym " ++ show name ++ ":"-                                               , go err-                                               ]-    go (ErrorInValueDeclaration n err) = paras [ line $ "Error in value declaration " ++ show n ++ ":"-                                               , go err-                                               ]-    go (ErrorInForeignImport nm err)   = paras [ line $ "Error in foreign import " ++ show nm ++ ":"-                                               , go err-                                               ]-    go (PositionedError pos err)       = paras [ line $ "Error at " ++ show pos ++ ":"-                                               , indent $ go err-                                               ]+    goSimple (CannotGetFileInfo path) =+      paras [ line "Unable to read file info: "+            , indent . line $ path+            ]+    goSimple (CannotReadFile path) =+      paras [ line "Unable to read file: "+            , indent . line $ path+            ]+    goSimple (CannotWriteFile path) =+      paras [ line "Unable to write file: "+            , indent . line $ path+            ]+    goSimple (ErrorParsingExterns err) =+      paras [ line "Error parsing externs files: "+            , indent . line . show $ err+            ]+    goSimple (ErrorParsingFFIModule path) =+      paras [ line "Unable to parse module from FFI file: "+            , indent . line $ path+            ]+    goSimple (ErrorParsingModule err) =+      paras [ line "Unable to parse module: "+            , indent . line . show $ err+            ]+    goSimple (MissingFFIModule mn) =+      line $ "Missing FFI implementations for module " ++ show mn+    goSimple (UnnecessaryFFIModule mn path) =+      paras [ line $ "Unnecessary FFI implementations have been provided for module " ++ show mn ++ ": "+            , indent . line $ path+            ]+    goSimple (MultipleFFIModules mn paths) =+      paras $ [ line $ "Multiple FFI implementations have been provided for module " ++ show mn ++ ": " ]+            ++ map (indent . line) paths+    goSimple (InvalidExternsFile path) =+      paras [ line "Externs file is invalid: "+            , indent . line $ path+            ]+    goSimple InvalidDoBind =+      line "Bind statement cannot be the last statement in a do block"+    goSimple InvalidDoLet =+      line "Let statement cannot be the last statement in a do block"+    goSimple CannotReorderOperators =+      line "Unable to reorder operators"+    goSimple UnspecifiedSkolemScope =+      line "Skolem variable scope is unspecified"+    goSimple OverlappingNamesInLet =+      line "Overlapping names in let binding."+    goSimple (InfiniteType ty) =+      paras [ line "Infinite type detected: "+            , indent $ line $ prettyPrintType ty+            ]+    goSimple (InfiniteKind ki) =+      paras [ line "Infinite kind detected: "+            , indent $ line $ prettyPrintKind ki+            ]+    goSimple (MultipleFixities name) =+      line $ "Multiple fixity declarations for " ++ show name+    goSimple (OrphanTypeDeclaration nm) =+      line $ "Orphan type declaration for " ++ show nm+    goSimple (OrphanFixityDeclaration op) =+      line $ "Orphan fixity declaration for " ++ show op+    goSimple (RedefinedModule name) =+      line $ "Module " ++ show name ++ " has been defined multiple times"+    goSimple (RedefinedIdent name) =+      line $ "Name " ++ show name ++ " has been defined multiple times"+    goSimple (UnknownModule mn) =+      line $ "Unknown module " ++ show mn+    goSimple (UnknownType name) =+      line $ "Unknown type " ++ show name+    goSimple (UnknownTypeClass name) =+      line $ "Unknown type class " ++ show name+    goSimple (UnknownValue name) =+      line $ "Unknown value " ++ show name+    goSimple (UnknownTypeConstructor name) =+      line $ "Unknown type constructor " ++ show name+    goSimple (UnknownDataConstructor dc tc) =+      line $ "Unknown data constructor " ++ show dc ++ foldMap ((" for type constructor " ++) . show) tc+    goSimple (ConflictingImport nm mn) =+      line $ "Cannot declare " ++ show nm ++ " since another declaration of that name was imported from " ++ show mn+    goSimple (ConflictingImports nm m1 m2) =+      line $ "Conflicting imports for " ++ show nm ++ " from modules " ++ show m1 ++ " and " ++ show m2+    goSimple (ConflictingTypeDecls nm) =+      line $ "Conflicting type declarations for " ++ show nm+    goSimple (ConflictingCtorDecls nm) =+      line $ "Conflicting data constructor declarations for " ++ show nm+    goSimple (TypeConflictsWithClass nm) =+      line $ "Type " ++ show nm ++ " conflicts with type class declaration of the same name"+    goSimple (CtorConflictsWithClass nm) =+      line $ "Data constructor " ++ show nm ++ " conflicts with type class declaration of the same name"+    goSimple (ClassConflictsWithType nm) =+      line $ "Type class " ++ show nm ++ " conflicts with type declaration of the same name"+    goSimple (ClassConflictsWithCtor nm) =+      line $ "Type class " ++ show nm ++ " conflicts with data constructor declaration of the same name"+    goSimple (DuplicateClassExport nm) =+      line $ "Duplicate export declaration for type class " ++ show nm+    goSimple (DuplicateValueExport nm) =+      line $ "Duplicate export declaration for value " ++ show nm+    goSimple (CycleInDeclaration nm) =+      line $ "Cycle in declaration of " ++ show nm+    goSimple (CycleInModules mns) =+      line $ "Cycle in module dependencies: " ++ intercalate ", " (map show mns)+    goSimple (CycleInTypeSynonym pn) =+      line $ "Cycle in type synonym" ++ foldMap ((" " ++) . show) pn+    goSimple (NameIsUndefined ident) =+      line $ show ident ++ " is undefined"+    goSimple (NameNotInScope ident) =+      line $ show ident ++ " may not be defined in the current scope"+    goSimple (UndefinedTypeVariable name) =+      line $ "Type variable " ++ show name ++ " is undefined"+    goSimple (PartiallyAppliedSynonym name) =+      line $ "Partially applied type synonym " ++ show name+    goSimple (EscapedSkolem binding) =+      paras $ [ line "Rigid/skolem type variable has escaped." ]+                     <> foldMap (\expr -> [ line "Relevant expression: "+                                          , indent $ line $ prettyPrintValue expr+                                          ]) binding+    goSimple (TypesDoNotUnify t1 t2)+      = paras [ line "Cannot unify type"+              , indent $ line $ prettyPrintType t1+              , line "with type"+              , indent $ line $ prettyPrintType t2+              ]+    goSimple (KindsDoNotUnify k1 k2) =+      paras [ line "Cannot unify kind"+            , indent $ line $ prettyPrintKind k1+            , line "with kind"+            , indent $ line $ prettyPrintKind k2+            ]+    goSimple (ConstrainedTypeUnified t1 t2) =+      paras [ line "Cannot unify constrained type"+            , indent $ line $ prettyPrintType t1+            , line "with type"+            , indent $ line $ prettyPrintType t2+            ]+    goSimple (OverlappingInstances nm ts ds) =+      paras [ line $ "Overlapping instances found for " ++ show nm ++ " " ++ unwords (map prettyPrintTypeAtom ts) ++ ":"+            , paras $ map prettyPrintDictionaryValue ds+            ]+    goSimple (NoInstanceFound nm ts) =+      line $ "No instance found for " ++ show nm ++ " " ++ unwords (map prettyPrintTypeAtom ts)+    goSimple (DuplicateLabel l expr) =+      paras $ [ line $ "Duplicate label " ++ show l ++ " in row." ]+                       <> foldMap (\expr' -> [ line "Relevant expression: "+                                             , indent $ line $ prettyPrintValue expr'+                                             ]) expr+    goSimple (DuplicateTypeArgument name) =+      line $ "Duplicate type argument " ++ show name+    goSimple (DuplicateValueDeclaration nm) =+      line $ "Duplicate value declaration for " ++ show nm+    goSimple (ArgListLengthsDiffer ident) =+      line $ "Argument list lengths differ in declaration " ++ show ident+    goSimple (OverlappingArgNames ident) =+      line $ "Overlapping names in function/binder" ++ foldMap ((" in declaration" ++) . show) ident+    goSimple (MissingClassMember ident) =+      line $ "Member " ++ show ident ++ " has not been implemented"+    goSimple (ExtraneousClassMember ident) =+      line $ "Member " ++ show ident ++ " is not a member of the class being instantiated"+    goSimple (ExpectedType kind) =+      line $ "Expected type of kind *, was " ++ prettyPrintKind kind+    goSimple (IncorrectConstructorArity nm) =+      line $ "Wrong number of arguments to constructor " ++ show nm+    goSimple SubsumptionCheckFailed = line $ "Unable to check type subsumption"+    goSimple (ExprDoesNotHaveType expr ty) =+      paras [ line "Expression"+            , indent $ line $ prettyPrintValue expr+            , line "does not have type"+            , indent $ line $ prettyPrintType ty+            ]+    goSimple (PropertyIsMissing prop row) =+      line $ "Row " ++ prettyPrintRow row ++ " lacks required property " ++ show prop+    goSimple (CannotApplyFunction fn arg) =+      paras [ line "Cannot apply function of type"+            , indent $ line $ prettyPrintType fn+            , line "to argument"+            , indent $ line $ prettyPrintValue arg+            ]+    goSimple TypeSynonymInstance =+      line "Type synonym instances are disallowed"+    goSimple InvalidNewtype =+      line "Newtypes must define a single constructor with a single argument"+    goSimple (InvalidInstanceHead ty) =+      paras [ line "Invalid type in class instance head:"+            , indent $ line $ prettyPrintType ty+            ]+    goSimple (TransitiveExportError x ys) =+      paras $ (line $ "An export for " ++ prettyPrintExport x ++ " requires the following to also be exported: ")+              : map (line . prettyPrintExport) ys+    goSimple (ShadowedName nm) =+      line $ "Name '" ++ show nm ++ "' was shadowed."+    goSimple (ClassOperator className opName) =+      paras [ line $ "Class '" ++ show className ++ "' declares operator " ++ show opName ++ "."+            , indent $ line $ "This may be disallowed in the future - consider declaring a named member in the class and making the operator an alias:"+            , indent $ line $ show opName ++ " = someMember"+            ]+    goSimple (WildcardInferredType ty) =+      line $ "The wildcard type definition has the inferred type " ++ prettyPrintType ty+    go (NotYetDefined names err) =+      paras [ line $ "The following are not yet defined here: " ++ intercalate ", " (map show names) ++ ":"+            , indent $ go err+            ]+    go (ErrorUnifyingTypes t1 t2 err) =+      paras [ line "Error unifying type "+            , indent $ line $ prettyPrintType t1+            , line "with type"+            , indent $ line $ prettyPrintType t2+            , go err+            ]+    go (ErrorInExpression expr err) =+      paras [ line "Error in expression:"+            , indent $ line $ prettyPrintValue expr+            , go err+            ]+    go (ErrorInModule mn err) =+      paras [ line $ "Error in module " ++ show mn ++ ":"+            , go err+            ]+    go (ErrorInSubsumption t1 t2 err) =+      paras [ line "Error checking that type "+            , indent $ line $ prettyPrintType t1+            , line "subsumes type"+            , indent $ line $ prettyPrintType t2+            , go err+            ]+    go (ErrorInInstance name ts err) =+      paras [ line $ "Error in type class instance " ++ show name ++ " " ++ unwords (map prettyPrintTypeAtom ts) ++ ":"+            , go err+            ]+    go (ErrorCheckingKind ty err) =+      paras [ line "Error checking kind of type "+            , indent $ line $ prettyPrintType ty+            , go err+            ]+    go (ErrorInferringType expr err) =+      paras [ line "Error inferring type of value "+            , indent $ line $ prettyPrintValue expr+            , go err+            ]+    go (ErrorCheckingType expr ty err) =+      paras [ line "Error checking that value "+            , indent $ line $ prettyPrintValue expr+            , line "has type"+            , indent $ line $ prettyPrintType ty+            , go err+            ]+    go (ErrorInApplication f t a err) =+      paras [ line "Error applying function"+            , indent $ line $ prettyPrintValue f+            , line "of type"+            , indent $ line $ prettyPrintType t+            , line "to argument"+            , indent $ line $ prettyPrintValue a+            , go err+            ]+    go (ErrorInDataConstructor nm err) =+      paras [ line $ "Error in data constructor " ++ show nm ++ ":"+            , go err+            ]+    go (ErrorInTypeConstructor nm err) =+      paras [ line $ "Error in type constructor " ++ show nm ++ ":"+            , go err+            ]+    go (ErrorInBindingGroup nms err) =+      paras [ line $ "Error in binding group " ++ intercalate ", " (map show nms) ++ ":"+            , go err+            ]+    go (ErrorInDataBindingGroup err) =+      paras [ line $ "Error in data binding group:"+            , go err+            ]+    go (ErrorInTypeSynonym name err) =+      paras [ line $ "Error in type synonym " ++ show name ++ ":"+            , go err+            ]+    go (ErrorInValueDeclaration n err) =+      paras [ line $ "Error in value declaration " ++ show n ++ ":"+            , go err+            ]+    go (ErrorInForeignImport nm err) =+      paras [ line $ "Error in foreign import " ++ show nm ++ ":"+            , go err+            ]+    go (PositionedError srcSpan err) =+      paras [ line $ "Error at " ++ displaySourceSpan srcSpan ++ ":"+            , indent $ go err+            ]+    go (SimpleErrorWrapper sem) = goSimple sem    line :: String -> Box.Box   line = Box.text +  suggestions :: ErrorMessage -> [Box.Box]+  suggestions = suggestions' . unwrapErrorMessage+    where+    suggestions' (ConflictingImport nm im) = [ line $ "Possible fix: hide " ++ show nm ++ " when importing " ++ show im ++ ":"+                                             , indent . line $ "import " ++ show im ++ " hiding (" ++ nm ++ ")"+                                             ]+    suggestions' (TypesDoNotUnify t1 t2)+      | any isObject [t1, t2] = [line "Note that function composition in PureScript is defined using (<<<)"]+      | otherwise             = []+    suggestions' _ = []+   paras :: [Box.Box] -> Box.Box   paras = Box.vcat Box.left @@ -429,15 +679,16 @@   prettyPrintDictionaryValue (SubclassDictionaryValue sup nm _) = paras [ line $ (show nm) ++ " via superclass"                                                                         , indent $ prettyPrintDictionaryValue sup                                                                         ]-  +   -- |   -- Pretty print and export declaration-  --  +  --   prettyPrintExport :: DeclarationRef -> String   prettyPrintExport (TypeRef pn _) = show pn   prettyPrintExport (ValueRef ident) = show ident   prettyPrintExport (TypeClassRef pn) = show pn   prettyPrintExport (TypeInstanceRef ident) = show ident+  prettyPrintExport (ModuleRef name) = "module " ++ show name   prettyPrintExport (PositionedDeclarationRef _ _ ref) = prettyPrintExport ref    -- |@@ -466,32 +717,50 @@     unwrap pos (NotYetDefined ns err) = NotYetDefined ns (unwrap pos err)     unwrap _   (PositionedError pos err) = unwrap (Just pos) err     unwrap pos other = wrap pos other-  +     wrap :: Maybe SourceSpan -> ErrorMessage -> ErrorMessage     wrap Nothing    = id     wrap (Just pos) = PositionedError pos + -- | -- Pretty print multiple errors -- prettyPrintMultipleErrors :: Bool -> MultipleErrors -> String-prettyPrintMultipleErrors full  (MultipleErrors [e]) = renderBox $-  prettyPrintSingleError full e -prettyPrintMultipleErrors full  (MultipleErrors es) = renderBox $-  Box.vcat Box.left [ Box.text "Multiple errors:"-                    , Box.vsep 1 Box.left $ map (Box.moveRight 2 . prettyPrintSingleError full) es-                    ]+prettyPrintMultipleErrors full = flip evalState M.empty . prettyPrintMultipleErrorsWith "Error:" "Multiple errors:" full +-- |+-- Pretty print multiple warnings+--+prettyPrintMultipleWarnings :: Bool -> MultipleErrors ->  String+prettyPrintMultipleWarnings full = flip evalState M.empty . prettyPrintMultipleErrorsWith "Warning:" "Multiple warnings:" full++prettyPrintMultipleErrorsWith :: String -> String -> Bool -> MultipleErrors -> State UnknownMap String+prettyPrintMultipleErrorsWith intro _ full  (MultipleErrors [e]) = do+  result <- prettyPrintSingleError full e+  return $ renderBox $+    Box.vcat Box.left [ Box.text intro+                      , result+                      ]+prettyPrintMultipleErrorsWith _ intro full  (MultipleErrors es) = do+  result <- forM es $ (liftM $ Box.moveRight 2) . prettyPrintSingleError full+  return $ renderBox $+    Box.vcat Box.left [ Box.text intro+                      , Box.vsep 1 Box.left result+                      ]+ renderBox :: Box.Box -> String renderBox = unlines . map trimEnd . lines . Box.render   where   trimEnd = reverse . dropWhile (== ' ') . reverse  -- |--- Interpret multiple errors in a monad supporting errors+-- Interpret multiple errors and warnings in a monad supporting errors and warnings ---interpretMultipleErrors :: (MonadError String m) => Bool -> Either MultipleErrors a -> m a-interpretMultipleErrors printFullStack = either (throwError . prettyPrintMultipleErrors printFullStack) return+interpretMultipleErrorsAndWarnings :: (MonadError MultipleErrors m, MonadWriter MultipleErrors m) => (Either MultipleErrors a, MultipleErrors) -> m a+interpretMultipleErrorsAndWarnings (err, ws) = do+  tell ws+  either throwError return $ err  -- | -- Rethrow an error with a more detailed error message in the case of failure

src/Language/PureScript/Kinds.hs view

@@ -13,11 +13,14 @@ -----------------------------------------------------------------------------  {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TemplateHaskell #-}  module Language.PureScript.Kinds where  import Data.Data+import qualified Data.Aeson.TH as A +import Control.Applicative import Control.Monad.Unify (Unknown)  -- |@@ -43,13 +46,22 @@   -- |   -- Function kinds   ---  | FunKind Kind Kind deriving (Show, Eq, Data, Typeable)+  | FunKind Kind Kind deriving (Show, Eq, Ord, Data, Typeable) +$(A.deriveJSON A.defaultOptions ''Kind)+ everywhereOnKinds :: (Kind -> Kind) -> Kind -> Kind everywhereOnKinds f = go   where   go (Row k1) = f (Row (go k1))   go (FunKind k1 k2) = f (FunKind (go k1) (go k2))+  go other = f other++everywhereOnKindsM :: (Functor m, Applicative m, Monad m) => (Kind -> m Kind) -> Kind -> m Kind+everywhereOnKindsM f = go+  where+  go (Row k1) = (Row <$> go k1) >>= f+  go (FunKind k1 k2) = (FunKind <$> go k1 <*> go k2) >>= f   go other = f other  everythingOnKinds :: (r -> r -> r) -> (Kind -> r) -> Kind -> r

+ src/Language/PureScript/Linter.hs view

@@ -0,0 +1,82 @@+-----------------------------------------------------------------------------+--+-- Module      :  Language.PureScript.Linter+-- Copyright   :  (c) Copyright 2015 PureScript+-- License     :  MIT+--+-- Maintainer  :  Phil Freeman <paf31@cantab.net>+-- Stability   :  experimental+-- Portability :+--+-- | This module implements a simple linting pass on the PureScript AST.+--+-----------------------------------------------------------------------------++{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Language.PureScript.Linter (lint) where++import Data.List (mapAccumL, nub)+import Data.Maybe (mapMaybe)+import Data.Monoid++import qualified Data.Set as S++import Control.Applicative+import Control.Monad.Writer.Class++import Language.PureScript.AST+import Language.PureScript.Names+import Language.PureScript.Errors++-- | Lint the PureScript AST.+-- |+-- | Right now, this pass only performs a shadowing check.+lint :: forall m. (Applicative m, MonadWriter MultipleErrors m) => Module -> m ()+lint (Module _ mn ds _) = censor (onErrorMessages (ErrorInModule mn)) $ mapM_ lintDeclaration ds+  where+  moduleNames :: S.Set Ident+  moduleNames = S.fromList (nub (mapMaybe getDeclIdent ds))++  getDeclIdent :: Declaration -> Maybe Ident+  getDeclIdent (PositionedDeclaration _ _ d) = getDeclIdent d+  getDeclIdent (ValueDeclaration ident _ _ _) = Just ident+  getDeclIdent (ExternDeclaration ident _) = Just ident+  getDeclIdent (ExternInstanceDeclaration ident _ _ _) = Just ident+  getDeclIdent (TypeInstanceDeclaration ident _ _ _ _) = Just ident+  getDeclIdent (BindingGroupDeclaration _) = error "lint: binding groups should not be desugared yet."+  getDeclIdent _ = Nothing++  lintDeclaration :: Declaration -> m ()+  lintDeclaration d =+    let (f, _, _, _, _) = everythingWithContextOnValues moduleNames mempty mappend stepD stepE stepB def def+    in tell (f d)+    where+    def s _ = (s, mempty)++    stepD :: S.Set Ident -> Declaration -> (S.Set Ident, MultipleErrors)+    stepD s (TypeClassDeclaration name _ _ decls) = (s, foldr go mempty decls)+      where+      go :: Declaration -> MultipleErrors -> MultipleErrors+      go (PositionedDeclaration _ _ d') errs = go d' errs+      go (TypeDeclaration op@(Op _) _) errs = errorMessage (ClassOperator name op) <> errs+      go _ errs = errs+    stepD s _ = (s, mempty)++    stepE :: S.Set Ident -> Expr -> (S.Set Ident, MultipleErrors)+    stepE s (Abs (Left name) _) = bind s name+    stepE s (Let ds' _) =+      case mapAccumL bind s (nub (mapMaybe getDeclIdent ds')) of+        (s', es) -> (s', mconcat es)+    stepE s _ = (s, mempty)++    stepB :: S.Set Ident -> Binder -> (S.Set Ident, MultipleErrors)+    stepB s (VarBinder name) = bind s name+    stepB s (NamedBinder name _) = bind s name+    stepB s _ = (s, mempty)++    bind :: S.Set Ident -> Ident -> (S.Set Ident, MultipleErrors)+    bind s name | name `S.member` s = (s, errorMessage (ShadowedName name))+                | otherwise = (S.insert name s, mempty)

src/Language/PureScript/ModuleDependencies.hs view

@@ -19,7 +19,7 @@   ModuleGraph ) where -import Control.Monad.Except+import Control.Monad.Error.Class (MonadError(..))  import Data.Graph import Data.List (nub)@@ -28,6 +28,7 @@ import Language.PureScript.AST import Language.PureScript.Names import Language.PureScript.Types+import Language.PureScript.Errors  -- | -- A list of modules with their dependencies@@ -39,7 +40,7 @@ -- -- Reports an error if the module graph contains a cycle. ---sortModules :: (MonadError String m) => [Module] -> m ([Module], ModuleGraph)+sortModules :: (MonadError MultipleErrors m) => [Module] -> m ([Module], ModuleGraph) sortModules ms = do   let verts = map (\m@(Module _ _ ds _) -> (m, getModuleName m, nub (concatMap usedModules ds))) ms   ms' <- mapM toModule $ stronglyConnComp verts@@ -70,7 +71,7 @@ -- | -- Convert a strongly connected component of the module graph to a module ---toModule :: (MonadError String m) => SCC Module -> m Module+toModule :: (MonadError MultipleErrors m) => SCC Module -> m Module toModule (AcyclicSCC m) = return m toModule (CyclicSCC [m]) = return m-toModule (CyclicSCC ms) = throwError $ "Cycle in module dependencies: " ++ show (map getModuleName ms)+toModule (CyclicSCC ms) = throwError . errorMessage $ CycleInModules (map getModuleName ms)

src/Language/PureScript/Names.hs view

@@ -13,12 +13,15 @@ -- ----------------------------------------------------------------------------- -{-# LANGUAGE DeriveDataTypeable, DeriveFunctor #-}+{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, GADTs #-}  module Language.PureScript.Names where  import Data.List import Data.Data+import Data.List.Split (splitOn)+import qualified Data.Aeson as A+import qualified Data.Text as T  -- | -- Names for value identifiers@@ -76,6 +79,20 @@ instance (Show a) => Show (Qualified a) where   show (Qualified Nothing a) = show a   show (Qualified (Just name) a) = show name ++ "." ++ show a++instance (a ~ ProperName) => A.ToJSON (Qualified a) where+  toJSON = A.toJSON . show++instance (a ~ ProperName) => A.FromJSON (Qualified a) where+  parseJSON =+    A.withText "Qualified ProperName" $ \str ->+      return $ case reverse (splitOn "." (T.unpack str)) of+        [name]      -> Qualified Nothing (ProperName name)+        (name:rest) -> Qualified (Just (reconstructModuleName rest)) (ProperName name)+        _           -> Qualified Nothing (ProperName "")+    where+    reconstructModuleName = moduleNameFromString . intercalate "." . reverse+  -- | -- Provide a default module name, if a name is unqualified

src/Language/PureScript/Options.hs view

@@ -13,80 +13,37 @@ -- ----------------------------------------------------------------------------- -{-# LANGUAGE GADTs, DataKinds, StandaloneDeriving #-}- module Language.PureScript.Options where  -- |--- Indicates the mode of the compiler. Lifted using DataKinds to refine the Options type.----data Mode = Compile | Make---- |--- Per-mode options----data ModeOptions mode where-  CompileOptions :: String -> [String] -> [String] -> ModeOptions Compile-  MakeOptions :: ModeOptions Make--browserNamespace :: ModeOptions Compile -> String-browserNamespace (CompileOptions ns _ _) = ns--entryPointModules :: ModeOptions Compile -> [String]-entryPointModules (CompileOptions _ ms _) = ms--codeGenModules :: ModeOptions Compile -> [String]-codeGenModules (CompileOptions _ _ ms) = ms--deriving instance Show (ModeOptions mode)---- | -- The data type of compiler options ---data Options mode = Options {-    -- |-    -- Disable inclusion of the built in Prelude-    ---    optionsNoPrelude :: Bool+data Options = Options {     -- |     -- Disable tail-call elimination-    ---  , optionsNoTco :: Bool+    optionsNoTco :: Bool     -- |     -- Disable inlining of calls to return and bind for the Eff monad-    --   , optionsNoMagicDo :: Bool     -- |     -- When specified, checks the type of `main` in the module, and generate a call to run main     -- after the module definitions.-    --   , optionsMain :: Maybe String     -- |     -- Skip all optimizations-    --   , optionsNoOptimizations :: Bool     -- |     -- Verbose error message-    --   , optionsVerboseErrors :: Bool     -- |     -- Remove the comments from the generated js   , optionsNoComments :: Bool     -- |-    -- Specify the namespace that PureScript modules will be exported to when running in the-    -- browser.-    ---  , optionsAdditional :: ModeOptions mode+    -- The path to prepend to require statements+  , optionsRequirePath :: Maybe FilePath   } deriving Show  -- |--- Default compiler options----defaultCompileOptions :: Options Compile-defaultCompileOptions = Options False False False Nothing False False False (CompileOptions "PS" [] [])---- | -- Default make options----defaultMakeOptions :: Options Make-defaultMakeOptions = Options False False False Nothing False False False MakeOptions+defaultOptions :: Options+defaultOptions = Options False False Nothing False False False Nothing

src/Language/PureScript/Parser.hs view

@@ -33,3 +33,4 @@ import Language.PureScript.Parser.Kinds as P import Language.PureScript.Parser.Lexer as P import Language.PureScript.Parser.Declarations as P+import Language.PureScript.Parser.JS as P

src/Language/PureScript/Parser/Common.hs view

@@ -27,6 +27,11 @@  import qualified Text.Parsec as P +featureWasRemoved :: String -> TokenParser a+featureWasRemoved err = do+  pos <- P.getPosition+  error $ "It looks like you are trying to use a feature from a previous version of the compiler:\n" ++ err ++ "\nat " ++ show pos+ properName :: TokenParser ProperName properName = ProperName <$> uname

src/Language/PureScript/Parser/Declarations.hs view

@@ -13,6 +13,8 @@ -- ----------------------------------------------------------------------------- +{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-}  module Language.PureScript.Parser.Declarations (@@ -30,22 +32,22 @@  import Prelude hiding (lex) -import Data.Maybe (isJust, fromMaybe)-import Data.Traversable (forM)+import Data.Maybe (fromMaybe)  import Control.Applicative import Control.Arrow ((+++))+import Control.Monad.Error.Class (MonadError(..)) -import Language.PureScript.Kinds import Language.PureScript.AST import Language.PureScript.Comments+import Language.PureScript.Environment+import Language.PureScript.Errors+import Language.PureScript.Kinds+import Language.PureScript.Names import Language.PureScript.Parser.Common-import Language.PureScript.Parser.Types import Language.PureScript.Parser.Kinds import Language.PureScript.Parser.Lexer-import Language.PureScript.Names-import Language.PureScript.CodeGen.JS.AST-import Language.PureScript.Environment+import Language.PureScript.Parser.Types  import qualified Language.PureScript.Parser.Common as C import qualified Text.Parsec as P@@ -99,7 +101,7 @@                                     <*> (indented *> equals *> parseValueWithWhereClause)                                ))        <|> Right <$> (indented *> equals *> parseValueWithWhereClause)-  return $ ValueDeclaration name Value binders value+  return $ ValueDeclaration name Public binders value   where   parseValueWithWhereClause :: TokenParser Expr   parseValueWithWhereClause = do@@ -118,17 +120,19 @@    <|> (do reserved "instance"            name <- parseIdent <* indented <* doubleColon            deps <- P.option [] $ do-             deps <- parens (commaSep1 ((,) <$> parseQualified properName <*> P.many (noWildcards parseTypeAtom)))+             deps' <- parens (commaSep1 ((,) <$> parseQualified properName <*> P.many (noWildcards parseTypeAtom)))              indented              rfatArrow-             return deps+             return deps'            className <- indented *> parseQualified properName            tys <- P.many (indented *> noWildcards parseTypeAtom)            return $ ExternInstanceDeclaration name deps className tys)    <|> (do ident <- parseIdent-           js <- P.optionMaybe (JSRaw <$> stringLiteral)+           -- TODO: add a wiki page link with migration info+           -- TODO: remove this deprecation warning in 0.8+           _ <- P.optional $ stringLiteral *> featureWasRemoved "Inline foreign string literals are no longer supported."            ty <- indented *> doubleColon *> noWildcards parsePolyType-           return $ ExternDeclaration (if isJust js then InlineJavascript else ForeignImport) ident js ty))+           return $ ExternDeclaration ident ty))  parseAssociativity :: TokenParser Associativity parseAssociativity =@@ -151,7 +155,7 @@   (mn, declType, asQ) <- parseImportDeclaration'   return $ ImportDeclaration mn declType asQ -parseImportDeclaration' :: TokenParser (ModuleName, ImportDeclarationType, (Maybe ModuleName))+parseImportDeclaration' :: TokenParser (ModuleName, ImportDeclarationType, Maybe ModuleName) parseImportDeclaration' = do   reserved "import"   indented@@ -177,16 +181,24 @@     asQ <- moduleName     return (moduleName', declType, Just asQ)   importDeclarationType expectedType = do-    idents <- P.optionMaybe $ indented *> (parens $ commaSep parseDeclarationRef)+    idents <- P.optionMaybe $ indented *> parens (commaSep parseDeclarationRef)     return $ fromMaybe Implicit (expectedType <$> idents)   parseDeclarationRef :: TokenParser DeclarationRef-parseDeclarationRef = withSourceSpan PositionedDeclarationRef $+parseDeclarationRef =+  parseModuleRef <|> (+  withSourceSpan PositionedDeclarationRef $   ValueRef <$> parseIdent     <|> do name <- properName            dctors <- P.optionMaybe $ parens (symbol' ".." *> pure Nothing <|> Just <$> commaSep properName)            return $ maybe (TypeClassRef name) (TypeRef name) dctors+  )+  where+  parseModuleRef :: TokenParser DeclarationRef+  parseModuleRef = do+    name <- indented *> reserved "module" *> moduleName+    return $ ModuleRef name  parseTypeClassDeclaration :: TokenParser Declaration parseTypeClassDeclaration = do@@ -213,14 +225,14 @@     rfatArrow     return deps   className <- indented *> parseQualified properName-  ty <- P.many (indented *> (noWildcards parseTypeAtom))+  ty <- P.many (indented *> noWildcards parseTypeAtom)   members <- P.option [] . P.try $ do     indented *> reserved "where"     mark (P.many (same *> positioned parseValueDeclaration))   return $ TypeInstanceDeclaration name (fromMaybe [] deps) className ty members  positioned :: TokenParser Declaration -> TokenParser Declaration-positioned d = withSourceSpan PositionedDeclaration d+positioned = withSourceSpan PositionedDeclaration  -- | -- Parse a single declaration@@ -261,14 +273,18 @@ -- | -- Parse a collection of modules ---parseModulesFromFiles :: (k -> String) -> [(k, String)] -> Either P.ParseError [(k, Module)]-parseModulesFromFiles toFilePath input =-  fmap collect . forM input $ \(k, content) -> do+parseModulesFromFiles :: forall m k. (MonadError MultipleErrors m, Functor m) =>+                                     (k -> String) -> [(k, String)] -> m [(k, Module)]+parseModulesFromFiles toFilePath input = do+  modules <- parU input $ \(k, content) -> do     let filename = toFilePath k-    ts <- lex filename content-    ms <- runTokenParser filename parseModules ts+    ts <- wrapError $ lex filename content+    ms <- wrapError $ runTokenParser filename parseModules ts     return (k, ms)+  return $ collect modules   where+  wrapError :: Either P.ParseError a -> m a+  wrapError = either (throwError . errorMessage . ErrorParsingModule) return   collect :: [(k, [v])] -> [(k, v)]   collect vss = [ (k, v) | (k, vs) <- vss, v <- vs ] @@ -284,6 +300,9 @@ parseNumericLiteral :: TokenParser Expr parseNumericLiteral = NumericLiteral <$> number +parseCharLiteral :: TokenParser Expr+parseCharLiteral = CharLiteral <$> charLiteral+ parseStringLiteral :: TokenParser Expr parseStringLiteral = StringLiteral <$> stringLiteral @@ -350,6 +369,7 @@ parseValueAtom :: TokenParser Expr parseValueAtom = P.choice             [ P.try parseNumericLiteral+            , P.try parseCharLiteral             , P.try parseStringLiteral             , P.try parseBooleanLiteral             , parseArrayLiteral@@ -442,6 +462,9 @@ parseStringBinder :: TokenParser Binder parseStringBinder = StringBinder <$> stringLiteral +parseCharBinder :: TokenParser Binder+parseCharBinder = CharBinder <$> charLiteral+ parseBooleanBinder :: TokenParser Binder parseBooleanBinder = BooleanBinder <$> booleanLiteral @@ -486,12 +509,14 @@ -- Parse a binder -- parseBinder :: TokenParser Binder-parseBinder = withSourceSpan PositionedBinder (P.buildExpressionParser operators parseBinderAtom P.<?> "expression")+parseBinder = withSourceSpan PositionedBinder (P.buildExpressionParser operators parseBinderAtom)   where-  operators = [ [ P.Infix (P.try $ C.indented *> colon *> return ConsBinder) P.AssocRight ] ]+  -- TODO: remove this deprecation warning in 0.8+  operators = [ [ P.Infix (P.try $ C.indented *> colon *> featureWasRemoved "Cons binders are no longer supported. Consider using purescript-lists or purescript-sequences instead.") P.AssocRight ] ]   parseBinderAtom :: TokenParser Binder   parseBinderAtom = P.choice (map P.try                     [ parseNullBinder+                    , parseCharBinder                     , parseStringBinder                     , parseBooleanBinder                     , parseNumberBinder@@ -508,6 +533,7 @@ parseBinderNoParens :: TokenParser Binder parseBinderNoParens = P.choice (map P.try                   [ parseNullBinder+                  , parseCharBinder                   , parseStringBinder                   , parseBooleanBinder                   , parseNumberBinder@@ -517,10 +543,9 @@                   , parseObjectBinder                   , parseArrayBinder                   , parens parseBinder ]) P.<?> "binder"+ -- | -- Parse a guard -- parseGuard :: TokenParser Guard parseGuard = pipe *> C.indented *> parseValue--

+ src/Language/PureScript/Parser/JS.hs view

@@ -0,0 +1,59 @@+-----------------------------------------------------------------------------+--+-- Module      :  Foreign+-- Copyright   :  (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors+-- License     :  MIT+--+-- Maintainer  :  Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>+-- Stability   :  experimental+-- Portability :+--+-- |+--+-----------------------------------------------------------------------------++{-# LANGUAGE FlexibleContexts #-}++module Language.PureScript.Parser.JS+  ( ForeignJS()+  , parseForeignModulesFromFiles+  ) where++import Control.Applicative ((*>), (<*))+import Control.Monad (forM_, when, msum)+import Control.Monad.Error.Class (MonadError(..))+import Control.Monad.Writer.Class (MonadWriter(..))+import Data.Function (on)+import Data.List (sortBy, groupBy)+import Language.PureScript.Errors+import Language.PureScript.Names+import Language.PureScript.Parser.Common+import Language.PureScript.Parser.Lexer+import Prelude hiding (lex)+import qualified Data.Map as M+import qualified Text.Parsec as PS++type ForeignJS = String++parseForeignModulesFromFiles :: (Functor m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)+                             => [(FilePath, ForeignJS)]+                             -> m (M.Map ModuleName (FilePath, ForeignJS))+parseForeignModulesFromFiles files = do+  foreigns <- parU files $ \(path, file) ->+    case findModuleName (lines file) of+      Just name -> return (name, (path, file))+      Nothing -> throwError (errorMessage $ ErrorParsingFFIModule path)+  let grouped = groupBy ((==) `on` fst) $ sortBy (compare `on` fst) foreigns+  forM_ grouped $ \grp ->+    when (length grp > 1) $ do+      let mn = fst (head grp)+          paths = map (fst . snd) grp+      tell $ errorMessage $ MultipleFFIModules mn paths+  return $ M.fromList foreigns++findModuleName :: [String] -> Maybe ModuleName+findModuleName = msum . map parseComment+  where+  parseComment :: String -> Maybe ModuleName+  parseComment s = either (const Nothing) Just $+    lex "" s >>= runTokenParser "" (symbol' "//" *> reserved "module" *> moduleName <* PS.eof)

src/Language/PureScript/Parser/Lexer.hs view

@@ -61,6 +61,7 @@   , symbol   , symbol'   , identifier+  , charLiteral   , stringLiteral   , number   , natural@@ -111,6 +112,7 @@   | UName String   | Qualifier String   | Symbol String+  | CharLiteral Char   | StringLiteral String   | Number (Either Integer Double)   deriving (Show, Eq, Ord)@@ -141,6 +143,7 @@ prettyPrintToken (UName s)         = show s prettyPrintToken (Qualifier _)     = "qualifier" prettyPrintToken (Symbol s)        = s+prettyPrintToken (CharLiteral c)   = show c prettyPrintToken (StringLiteral s) = show s prettyPrintToken (Number n)        = either show show n @@ -204,6 +207,7 @@   , do uName <- parseUName        (guard (validModuleName uName) >> Qualifier uName <$ P.char '.') <|> pure (UName uName)   , Symbol        <$> parseSymbol+  , CharLiteral   <$> parseCharLiteral   , StringLiteral <$> parseStringLiteral   , Number        <$> parseNumber   ] <* whitespace@@ -230,15 +234,25 @@   symbolChar :: P.Parsec String u Char   symbolChar = P.oneOf opChars +  parseCharLiteral :: P.Parsec String u Char+  parseCharLiteral = PT.charLiteral tokenParser+   parseStringLiteral :: P.Parsec String u String   parseStringLiteral = blockString <|> PT.stringLiteral tokenParser     where-    delimeter   = P.try (P.string "\"\"\"")-    blockString = delimeter >> P.manyTill P.anyChar delimeter+    delimiter   = P.try (P.string "\"\"\"")+    blockString = delimiter >> P.manyTill P.anyChar delimiter    parseNumber :: P.Parsec String u (Either Integer Double)-  parseNumber = (Right <$> P.try (PT.float tokenParser) <|>-                 Left <$> P.try (PT.natural tokenParser)) P.<?> "number"+  parseNumber = (consumeLeadingZero >> P.parserZero) <|>+                  (Right <$> P.try (PT.float tokenParser) <|>+                  Left <$> P.try (PT.natural tokenParser))+                P.<?> "number"+    where+    -- lookAhead doesn't consume any input if its parser succeeds+    -- if notFollowedBy fails though, the consumed '0' will break the choice chain+    consumeLeadingZero = P.lookAhead (P.char '0' >> +      (P.notFollowedBy P.digit P.<?> "no leading zero in number literal"))  -- | -- We use Text.Parsec.Token to implement the string and number lexemes@@ -431,6 +445,12 @@   go (Symbol s') | s == s'   = Just ()   go Colon       | s == ":"  = Just ()   go LFatArrow   | s == "<=" = Just ()+  go _ = Nothing++charLiteral :: TokenParser Char+charLiteral = token go P.<?> "char literal"+  where+  go (CharLiteral c) = Just c   go _ = Nothing  stringLiteral :: TokenParser String

src/Language/PureScript/Parser/Types.hs view

@@ -32,11 +32,16 @@ import qualified Text.Parsec as P import qualified Text.Parsec.Expr as P +-- TODO: remove these deprecation warnings in 0.8 parseArray :: TokenParser Type-parseArray = squares $ return tyArray+parseArray = do+  _ <- squares $ return tyArray+  featureWasRemoved "Array notation is no longer supported. Use Array instead of []."  parseArrayOf :: TokenParser Type-parseArrayOf = squares $ TypeApp tyArray <$> parseType+parseArrayOf = do+  _ <- squares $ TypeApp tyArray <$> parseType+  featureWasRemoved "Array notation is no longer supported. Use Array _ instead of [_]."  parseFunction :: TokenParser Type parseFunction = parens $ rarrow >> return tyFunction@@ -126,9 +131,7 @@ parseNameAndType p = (,) <$> (indented *> (lname <|> stringLiteral) <* indented <* doubleColon) <*> p  parseRowEnding :: TokenParser Type-parseRowEnding = P.option REmpty $ indented *> pipe *> indented *> P.choice  (map P.try-            [ parseTypeWildcard-            , TypeVar <$> identifier ])+parseRowEnding = P.option REmpty $ indented *> pipe *> indented *> parseType  parseRow :: TokenParser Type parseRow = (curry rowFromList <$> commaSep (parseNameAndType parsePolyType) <*> parseRowEnding) P.<?> "row"

src/Language/PureScript/Pretty/Types.hs view

@@ -37,9 +37,8 @@   match TypeWildcard = Just "_"   match (TypeVar var) = Just var   match (PrettyPrintObject row) = Just $ "{ " ++ prettyPrintRow row ++ " }"-  match (PrettyPrintArray ty) = Just $ "[" ++ prettyPrintType ty ++ "]"   match (TypeConstructor ctor) = Just $ show ctor-  match (TUnknown u) = Just $ 'u' : show u+  match (TUnknown u) = Just $ '_' : show u   match (Skolem name s _) = Just $ name ++ show s   match (ConstrainedType deps ty) = Just $ "(" ++ intercalate ", " (map (\(pn, ty') -> show pn ++ " " ++ unwords (map prettyPrintTypeAtom ty')) deps) ++ ") => " ++ prettyPrintType ty   match (SaturatedTypeSynonym name args) = Just $ show name ++ "<" ++ intercalate "," (map prettyPrintTypeAtom args) ++ ">"@@ -84,7 +83,6 @@ insertPlaceholders = everywhereOnTypesTopDown convertForAlls . everywhereOnTypes convert   where   convert (TypeApp (TypeApp f arg) ret) | f == tyFunction = PrettyPrintFunction arg ret-  convert (TypeApp a el) | a == tyArray = PrettyPrintArray el   convert (TypeApp o r) | o == tyObject = PrettyPrintObject r   convert other = other   convertForAlls (ForAll ident ty _) = go [ident] ty

src/Language/PureScript/Pretty/Values.hs view

@@ -37,6 +37,7 @@   match :: Expr -> StateT PrinterState Maybe String   match (NumericLiteral n) = return $ either show show n   match (StringLiteral s) = return $ show s+  match (CharLiteral c) = return $ show c   match (BooleanLiteral True) = return "true"   match (BooleanLiteral False) = return "false"   match (ArrayLiteral xs) = concat <$> sequence@@ -70,7 +71,7 @@     ]   match (Var ident) = return $ show ident   match (Do els) = concat <$> sequence-    [ return "do "+    [ return "do\n"     , withIndent $ prettyPrintMany prettyPrintDoNotationElement els     , currentIndent     ]@@ -98,7 +99,10 @@     , prettyPrintResult result     ]   where-  prettyPrintResult (Left gs) = concat <$> mapM prettyPrintGuardedValue gs+  prettyPrintResult (Left gs) = concat <$> sequence+      [ return "\n"+      , withIndent $ prettyPrintMany prettyPrintGuardedValue gs+      ]   prettyPrintResult (Right v) = (" -> " ++) <$> prettyPrintValue' v    prettyPrintGuardedValue (grd, val) =@@ -107,7 +111,6 @@       , prettyPrintValue' grd       , return " -> "       , prettyPrintValue' val-      , return "\n"       ]  prettyPrintDoNotationElement :: DoNotationElement -> StateT PrinterState Maybe String@@ -193,6 +196,7 @@   match :: Binder -> StateT PrinterState Maybe String   match NullBinder = return "_"   match (StringBinder str) = return $ show str+  match (CharBinder c) = return $ show c   match (NumberBinder num) = return $ either show show num   match (BooleanBinder True) = return "true"   match (BooleanBinder False) = return "false"@@ -214,7 +218,6 @@     ]   match (NamedBinder ident binder) = ((show ident ++ "@") ++) <$> prettyPrintBinder' binder   match (PositionedBinder _ _ binder) = prettyPrintBinder' binder-  match _ = mzero  -- | -- Generate a pretty-printed string representing a Binder@@ -226,16 +229,7 @@ prettyPrintBinder' = runKleisli $ runPattern matchBinder   where   matchBinder :: Pattern PrinterState Binder String-  matchBinder = buildPrettyPrinter operators (prettyPrintBinderAtom <+> fmap parens matchBinder)-  operators :: OperatorTable PrinterState Binder String-  operators =-    OperatorTable [ [ AssocR matchConsBinder (\b1 b2 -> b1 ++ " : " ++ b2) ] ]--matchConsBinder :: Pattern PrinterState Binder (Binder, Binder)-matchConsBinder = mkPattern match'-  where-  match' (ConsBinder b1 b2) = Just (b1, b2)-  match' _ = Nothing+  matchBinder = prettyPrintBinderAtom <+> fmap parens matchBinder  prettyPrintObjectPropertyBinder :: (String, Binder) -> StateT PrinterState Maybe String prettyPrintObjectPropertyBinder (key, binder) = concat <$> sequence

src/Language/PureScript/Renamer.hs view

@@ -14,6 +14,8 @@ -- ----------------------------------------------------------------------------- +{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}+ module Language.PureScript.Renamer (renameInModules) where  import Control.Applicative@@ -74,13 +76,12 @@ updateScope i@(Ident name) | name == C.__unused = return i updateScope name = do   scope <- get-  let name' = case name `S.member` rsUsedNames scope of-                True ->-                  let-                    newNames = [ Ident (runIdent name ++ "_" ++ show (i :: Int)) | i <- [1..] ]-                    Just newName = find (`S.notMember` rsUsedNames scope) newNames-                  in newName-                False -> name+  name' <- case name `S.member` rsUsedNames scope of+             True -> do+               let newNames = [ Ident (runIdent name ++ "_" ++ show (i :: Int)) | i <- [1..] ]+                   Just newName = find (`S.notMember` rsUsedNames scope) newNames+               return newName+             False -> return name   modify $ \s -> s { rsBoundNames = M.insert name name' (rsBoundNames s)                    , rsUsedNames  = S.insert name' (rsUsedNames s)                    }@@ -113,7 +114,8 @@ renameInModules = map go   where   go :: Module Ann -> Module Ann-  go m@(Module _ _ _ _ _ decls) = m { moduleDecls = renameInDecl' (findDeclIdents decls) `map` decls }+  go m@(Module _ _ _ _ _ decls) = m { moduleDecls = map (renameInDecl' (findDeclIdents decls)) decls }+     renameInDecl' :: [Ident] -> Bind Ann -> Bind Ann   renameInDecl' scope = runRename scope . renameInDecl True @@ -175,7 +177,7 @@ -- Renames within case alternatives. -- renameInCaseAlternative :: CaseAlternative Ann -> Rename (CaseAlternative Ann)-renameInCaseAlternative (CaseAlternative bs v) =+renameInCaseAlternative (CaseAlternative bs v) = newScope $   CaseAlternative <$> mapM renameInBinder bs                   <*> eitherM (mapM (pairM renameInValue renameInValue)) renameInValue v

src/Language/PureScript/Sugar.hs view

@@ -20,7 +20,7 @@ import Control.Monad import Control.Category ((>>>)) import Control.Applicative-import Control.Monad.Error.Class+import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.Supply.Class  import Language.PureScript.AST

src/Language/PureScript/Sugar/BindingGroups.hs view

@@ -28,7 +28,7 @@ import Data.Maybe (isJust, mapMaybe) import Control.Applicative import Control.Monad ((<=<))-import Control.Monad.Error.Class+import Control.Monad.Error.Class (MonadError(..))  import qualified Data.Set as S @@ -157,7 +157,6 @@ -- toBindingGroup :: (Functor m, MonadError MultipleErrors m) => ModuleName -> SCC Declaration -> m Declaration toBindingGroup _ (AcyclicSCC d) = return d-toBindingGroup _ (CyclicSCC [d]) = return d toBindingGroup moduleName (CyclicSCC ds') =   -- Once we have a mutually-recursive group of declarations, we need to sort   -- them further by their immediate dependencies (those outside function

src/Language/PureScript/Sugar/CaseDeclarations.hs view

@@ -14,7 +14,7 @@ -- ----------------------------------------------------------------------------- -{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}  module Language.PureScript.Sugar.CaseDeclarations (     desugarCases,@@ -25,9 +25,8 @@ import Data.List (nub, groupBy)  import Control.Applicative-import Control.Monad ((<=<), forM, join, unless, replicateM)-import Control.Monad.Except (throwError)-import Control.Monad.Error.Class (MonadError)+import Control.Monad ((<=<), forM, replicateM, join, unless)+import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.Supply.Class  import Language.PureScript.Names@@ -90,12 +89,24 @@ inSameGroup d1 (PositionedDeclaration _ _ d2) = inSameGroup d1 d2 inSameGroup _ _ = False -toDecls :: (Functor m, Applicative m, MonadSupply m, MonadError MultipleErrors m) => [Declaration] -> m [Declaration]+toDecls :: forall m. (Functor m, Applicative m, Monad m, MonadSupply m, MonadError MultipleErrors m) => [Declaration] -> m [Declaration] toDecls [ValueDeclaration ident nameKind bs (Right val)] | all isVarBinder bs = do-  let args = map (\(VarBinder arg) -> arg) bs-      body = foldr (Abs . Left) val args+  args <- mapM fromVarBinder bs+  let body = foldr (Abs . Left) val args   guardWith (errorMessage (OverlappingArgNames (Just ident))) $ length (nub args) == length args   return [ValueDeclaration ident nameKind [] (Right body)]+  where+  isVarBinder :: Binder -> Bool+  isVarBinder NullBinder = True+  isVarBinder (VarBinder _) = True+  isVarBinder (PositionedBinder _ _ b) = isVarBinder b+  isVarBinder _ = False++  fromVarBinder :: Binder -> m Ident+  fromVarBinder NullBinder = Ident <$> freshName+  fromVarBinder (VarBinder name) = return name+  fromVarBinder (PositionedBinder _ _ b) = fromVarBinder b+  fromVarBinder _ = error "fromVarBinder: Invalid argument" toDecls ds@(ValueDeclaration ident _ bs result : _) = do   let tuples = map toTuple ds   unless (all ((== length bs) . length . fst) tuples) $@@ -109,49 +120,57 @@   return (PositionedDeclaration pos com d' : ds') toDecls ds = return ds -isVarBinder :: Binder -> Bool-isVarBinder (VarBinder _) = True-isVarBinder _ = False- toTuple :: Declaration -> ([Binder], Either [(Guard, Expr)] Expr) toTuple (ValueDeclaration _ _ bs result) = (bs, result) toTuple (PositionedDeclaration _ _ d) = toTuple d toTuple _ = error "Not a value declaration" -makeCaseDeclaration :: (Functor m, Applicative m, MonadSupply m, MonadError MultipleErrors m) => Ident -> [([Binder], Either [(Guard, Expr)] Expr)] -> m Declaration+makeCaseDeclaration :: forall m. (Functor m, Applicative m, MonadSupply m, MonadError MultipleErrors m) => Ident -> [([Binder], Either [(Guard, Expr)] Expr)] -> m Declaration makeCaseDeclaration ident alternatives = do   let namedArgs = map findName . fst <$> alternatives       argNames = map join $ foldl1 resolveNames namedArgs-  args <- if allUnique (catMaybes argNames) -            then mapM argName argNames +  args <- if allUnique (catMaybes argNames)+            then mapM argName argNames             else replicateM (length argNames) (Ident <$> freshName)   let vars = map (Var . Qualified Nothing) args       binders = [ CaseAlternative bs result | (bs, result) <- alternatives ]       value = foldr (Abs . Left) (Case vars binders) args-  return $ ValueDeclaration ident Value [] (Right value)+  return $ ValueDeclaration ident Public [] (Right value)   where+  -- We will construct a table of potential names.+  -- VarBinders will become Just (Just _) which is a potential name.+  -- NullBinder will become Just Nothing, which indicates that we may+  -- have to generate a name.+  -- Everything else becomes Nothing, which indicates that we definitely+  -- have to generate a name.   findName :: Binder -> Maybe (Maybe Ident)   findName NullBinder = Just Nothing   findName (VarBinder name) = Just (Just name)   findName (PositionedBinder _ _ binder) = findName binder   findName _ = Nothing +  -- We still have to make sure the generated names are unique, or else+  -- we will end up constructing an invalid function.   allUnique :: (Eq a) => [a] -> Bool   allUnique xs = length xs == length (nub xs) -  argName :: (MonadSupply m) => Maybe Ident -> m Ident+  argName :: Maybe Ident -> m Ident   argName (Just name) = return name   argName _ = do     name <- freshName     return (Ident name) -  resolveNames :: [Maybe (Maybe Ident)] -> -                  [Maybe (Maybe Ident)] -> +  -- Combine two lists of potential names from two case alternatives+  -- by zipping correspoding columns.+  resolveNames :: [Maybe (Maybe Ident)] ->+                  [Maybe (Maybe Ident)] ->                   [Maybe (Maybe Ident)]   resolveNames = zipWith resolveName -  resolveName :: Maybe (Maybe Ident) -> -                 Maybe (Maybe Ident) -> +  -- Resolve a pair of names. VarBinder beats NullBinder, and everything+  -- else results in Nothing.+  resolveName :: Maybe (Maybe Ident) ->+                 Maybe (Maybe Ident) ->                  Maybe (Maybe Ident)   resolveName (Just (Just a)) (Just (Just b))     | a == b = Just (Just a)

src/Language/PureScript/Sugar/DoNotation.hs view

@@ -10,7 +10,7 @@ -- -- | -- This module implements the desugaring pass which replaces do-notation statements with--- appropriate calls to (>>=) from the Prelude.Monad type class.+-- appropriate calls to bind from the Prelude.Monad type class. -- ----------------------------------------------------------------------------- @@ -28,11 +28,11 @@ import qualified Language.PureScript.Constants as C  import Control.Applicative-import Control.Monad.Error.Class+import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.Supply.Class  -- |--- Replace all @DoNotationBind@ and @DoNotationValue@ constructors with applications of the Prelude.(>>=) function,+-- Replace all @DoNotationBind@ and @DoNotationValue@ constructors with applications of the Prelude.bind function, -- and all @DoNotationLet@ constructors with let expressions. -- desugarDoModule :: forall m. (Applicative m, MonadSupply m, MonadError MultipleErrors m) => Module -> m Module@@ -44,11 +44,8 @@   let (f, _, _) = everywhereOnValuesM return replace return   in f d   where-  prelude :: ModuleName-  prelude = ModuleName [ProperName C.prelude]-   bind :: Expr-  bind = Var (Qualified (Just prelude) (Op (C.>>=)))+  bind = Var (Qualified Nothing (Ident (C.bind)))    replace :: Expr -> m Expr   replace (Do els) = go els

src/Language/PureScript/Sugar/Names.hs view

@@ -14,16 +14,18 @@  {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE PatternGuards #-}  module Language.PureScript.Sugar.Names (   desugarImports ) where -import Data.List (nub)-import Data.Maybe (fromMaybe, isJust, mapMaybe)+import Data.List (find, nub, (\\))+import Data.Maybe (catMaybes, fromMaybe, isJust, mapMaybe)  import Control.Applicative (Applicative(..), (<$>), (<*>))-import Control.Monad.Except+import Control.Monad+import Control.Monad.Error.Class (MonadError(..))  import qualified Data.Map as M @@ -58,6 +60,10 @@   -- The values exported from each module   --   , exportedValues :: [Ident]+  -- |+  -- The modules exported from each module+  --+  , exportedModules :: [ModuleName]   } deriving (Show)  -- |@@ -100,7 +106,7 @@ addEmptyModule env name =   if name `M.member` env     then throwError . errorMessage $ RedefinedModule name-    else return $ M.insert name (Exports [] [] []) env+    else return $ M.insert name (Exports [] [] [] []) env  -- | -- Adds a type belonging to a module to the export environment.@@ -141,7 +147,7 @@ -- Adds an entry to a list of exports unless it is already present, in which case an error is -- returned. ---addExport :: (Applicative m, MonadError MultipleErrors m, Eq a, Show a) => (a -> ErrorMessage) -> [a] -> a -> m [a]+addExport :: (Applicative m, MonadError MultipleErrors m, Eq a, Show a) => (a -> SimpleErrorMessage) -> [a] -> a -> m [a] addExport what exports name =   if name `elem` exports   then throwConflictError what name@@ -154,13 +160,65 @@ desugarImports modules = do   unfilteredExports <- findExports modules   exports <- foldM filterModuleExports unfilteredExports modules-  mapM (renameInModule' unfilteredExports exports) modules+  let modules' = moduleReexports <$> modules+  mapM (renameInModule' unfilteredExports exports) modules'   where+  moduleReexports :: Module -> Module+  moduleReexports (Module coms mn decls exps) =+    let importedMods = catMaybes findImports'+    in (Module coms mn (decls ++ (concatMap reexports importedMods)) exps)+    where+    imports :: [Declaration]+    imports = filter isImportDecl decls+    findImports' :: [Maybe (Declaration, Module)]+    findImports' = go <$> modules+      where+      go :: Module -> Maybe (Declaration, Module)+      go m@(Module _ mn' _ (Just exps'))+        | any isModExport exps', Just d <- find ((== mn') . importedModName) imports = Just (d, m)+        where+        importedModName :: Declaration -> ModuleName+        importedModName (ImportDeclaration imn _ _) = imn+        importedModName (PositionedDeclaration _ _ d) = importedModName d+        importedModName _ = error "Not an import decl"+      go _ = Nothing+    reexports :: (Declaration, Module) -> [Declaration]+    reexports (ImportDeclaration _ (Hiding refs) _, (Module coms' mn' ds' (Just exps'))) =+      case nonHiddenRefs of+        [] -> []+        _ -> reexports (ImportDeclaration mn' Implicit Nothing, Module coms' mn' ds' (Just nonHiddenRefs))+      where+      nonHiddenRefs :: [DeclarationRef]+      nonHiddenRefs = filter isModExport exps' \\ filter isModExport refs+    reexports (ImportDeclaration _ ty qual, Module _ _ _ (Just exps')) =+      let ty' = case ty of+                  Explicit _ -> Explicit []+                  _ -> ty+      in (\m -> ImportDeclaration m ty' qual) <$> (catMaybes $ go <$> exps')+      where+      go :: DeclarationRef -> Maybe ModuleName+      go (ModuleRef mn') = Just mn'+      go _ = Nothing+    reexports (PositionedDeclaration _ _ d, m@(Module _ _ _ (Just _))) = reexports (d, m)+    reexports _ = [] +  isModExport :: DeclarationRef -> Bool+  isModExport (ModuleRef _) = True+  isModExport _ = False+   -- Filters the exports for a module in the global exports environment so that only explicitly   -- exported members remain. If the module does not explicitly export anything, everything is   -- exported.   filterModuleExports :: ExportEnvironment -> Module -> m ExportEnvironment+  filterModuleExports env (Module _ mn _ (Just exps))+    | any isSelfModuleExport exps, Just exps' <- M.lookup mn env =+        let moduleNames = filter (/= mn) $ (\(ModuleRef mn') -> mn') <$> filter isModExport exps+        in return $ M.insert mn (exps' {exportedModules = moduleNames}) env+    where+    isSelfModuleExport :: DeclarationRef -> Bool+    isSelfModuleExport (ModuleRef mn') | mn' == mn = True+    isSelfModuleExport (PositionedDeclarationRef _ _ ref) = isSelfModuleExport ref+    isSelfModuleExport _ = False   filterModuleExports env (Module _ mn _ (Just exps)) = filterExports mn exps env   filterModuleExports env _ = return env @@ -182,7 +240,8 @@ elaborateExports exps (Module coms mn decls _) = Module coms mn decls (Just $   map (\(ctor, dctors) -> TypeRef ctor (Just dctors)) (exportedTypes exps) ++   map TypeClassRef (exportedTypeClasses exps) ++-  map ValueRef (exportedValues exps))+  map ValueRef (exportedValues exps) +++  map ModuleRef (exportedModules exps))  -- | -- Add `import X ()` for any modules where there are only fully qualified references to members.@@ -225,8 +284,8 @@     (,) (pos, bound) <$> (ExternInstanceDeclaration name <$> updateConstraints pos cs <*> updateClassName cn Nothing <*> mapM (updateTypesEverywhere pos) ts)   updateDecl (pos, bound) (TypeDeclaration name ty) =     (,) (pos, bound) <$> (TypeDeclaration name <$> updateTypesEverywhere pos ty)-  updateDecl (pos, bound) (ExternDeclaration fit name js ty) =-    (,) (pos, name : bound) <$> (ExternDeclaration fit name js <$> updateTypesEverywhere pos ty)+  updateDecl (pos, bound) (ExternDeclaration name ty) =+    (,) (pos, name : bound) <$> (ExternDeclaration name <$> updateTypesEverywhere pos ty)   updateDecl s d = return (s, d)    updateValue :: (Maybe SourceSpan, [Ident]) -> Expr -> m ((Maybe SourceSpan, [Ident]), Expr)@@ -278,7 +337,7 @@    -- Update names so unqualified references become qualified, and locally qualified references   -- are replaced with their canoncial qualified names (e.g. M.Map -> Data.Map.Map)-  update :: (Ord a, Show a) => (Qualified a -> ErrorMessage)+  update :: (Ord a, Show a) => (Qualified a -> SimpleErrorMessage)                             -> (ImportEnvironment -> M.Map (Qualified a) (Qualified a))                             -> (Exports -> a -> Bool)                             -> Qualified a@@ -313,7 +372,7 @@   where    -- The exported types from the Prim module-  primExports = Exports (mkTypeEntry `map` M.keys primTypes) [] []+  primExports = Exports (mkTypeEntry `map` M.keys primTypes) [] [] []     where     mkTypeEntry (Qualified _ name) = (name, []) @@ -336,7 +395,7 @@   addDecl mn env (TypeSynonymDeclaration tn _ _) = addType env mn tn []   addDecl mn env (ExternDataDeclaration tn _) = addType env mn tn []   addDecl mn env (ValueDeclaration name _ _ _) = addValue env mn name-  addDecl mn env (ExternDeclaration _ name _ _) = addValue env mn name+  addDecl mn env (ExternDeclaration name _) = addValue env mn name   addDecl mn env (PositionedDeclaration pos _ d) = rethrowWithPosition pos $ addDecl mn env d   addDecl _  env _ = return env @@ -357,7 +416,8 @@     types' <- foldM (filterTypes $ exportedTypes exported) [] exps     values <- foldM (filterValues $ exportedValues exported) [] exps     classes <- foldM (filterClasses $ exportedTypeClasses exported) [] exps-    return exported { exportedTypes = types', exportedTypeClasses = classes, exportedValues = values }+    modules <- foldM (filterModules $ exportedModules exported) [] exps+    return exported { exportedTypes = types', exportedTypeClasses = classes, exportedValues = values, exportedModules = modules }    -- Ensure the exported types and data constructors exist in the module and add them to the set of   -- exports@@ -394,6 +454,12 @@     else throwError . errorMessage . UnknownValue $ Qualified (Just mn) name   filterValues _ result _ = return result +  -- Add the exported modules to the set of exports+  filterModules :: [ModuleName] -> [ModuleName] -> DeclarationRef -> m [ModuleName]+  filterModules exps' result (PositionedDeclarationRef pos _ r) = rethrowWithPosition pos $ filterModules exps' result r+  filterModules _ result (ModuleRef name) = return $ name : result+  filterModules _ result _ = return result+ -- | -- Finds the imports within a module, mapping the imported module name to an optional set of -- explicitly imported declarations.@@ -500,6 +566,8 @@       return ref     check ref@(TypeClassRef name) =       checkImportExists UnknownTypeClass classes name >> return ref+    check ref@(ModuleRef name) =+      checkImportExists (UnknownModule . (\(Qualified _ m) -> m)) (exportedModules exps) name >> return ref     check _ = error "Invalid argument to checkRefIsValid"    -- Find all exported data constructors for a given type@@ -513,8 +581,8 @@     Just (Qualified Nothing _) -> error "Invalid state in updateImports"     Just (Qualified (Just mn) _) -> throwError . errorMessage $ err       where-      err = if mn == currentModule || importModule == currentModule-            then ConflictingImport (show name) mn+      err = if currentModule `elem` [mn, importModule]+            then ConflictingImport (show name) importModule             else ConflictingImports (show name) mn importModule    -- The available values, types, and classes in the module being imported@@ -528,7 +596,7 @@   checkDctorExists = checkImportExists (flip UnknownDataConstructor Nothing)    -- Check that an explicitly imported item exists in the module it is being imported from-  checkImportExists :: (Eq a, Show a) => (Qualified a -> ErrorMessage) -> [a] -> a -> m a+  checkImportExists :: (Eq a, Show a) => (Qualified a -> SimpleErrorMessage) -> [a] -> a -> m a   checkImportExists unknown exports item =       if item `elem` exports       then return item@@ -537,5 +605,5 @@ -- | -- Raises an error for when there is more than one definition for something. ---throwConflictError :: (Applicative m, MonadError MultipleErrors m, Show a) => (a -> ErrorMessage) -> a -> m b+throwConflictError :: (Applicative m, MonadError MultipleErrors m, Show a) => (a -> SimpleErrorMessage) -> a -> m b throwConflictError conflict = throwError . errorMessage . conflict

src/Language/PureScript/Sugar/ObjectWildcards.hs view

@@ -21,7 +21,7 @@  import Control.Applicative import Control.Arrow (second)-import Control.Monad.Error.Class+import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.Supply.Class  import Data.List (partition)

src/Language/PureScript/Sugar/Operators.hs view

@@ -33,7 +33,7 @@  import Control.Applicative import Control.Monad.State-import Control.Monad.Except+import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.Supply.Class  import Data.Function (on)

src/Language/PureScript/Sugar/TypeClasses.hs view

@@ -35,7 +35,7 @@  import Control.Applicative import Control.Arrow (first, second)-import Control.Monad.Except+import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.State import Data.List ((\\), find, sortBy) import Data.Maybe (catMaybes, mapMaybe, isJust)@@ -59,7 +59,7 @@   return $ Module coms name (concat declss) $ Just (exps ++ catMaybes newExpss)   where   classesFirst :: Declaration -> Declaration -> Ordering-  classesFirst d1 d2 +  classesFirst d1 d2     | isTypeClassDeclaration d1 && not (isTypeClassDeclaration d2) = LT     | not (isTypeClassDeclaration d1) && isTypeClassDeclaration d2 = GT     | otherwise = EQ@@ -219,7 +219,7 @@ typeClassMemberToDictionaryAccessor :: ModuleName -> ProperName -> [(String, Maybe Kind)] -> Declaration -> Declaration typeClassMemberToDictionaryAccessor mn name args (TypeDeclaration ident ty) =   let className = Qualified (Just mn) name-  in ValueDeclaration ident TypeClassAccessorImport [] $ Right $+  in ValueDeclaration ident Private [] $ Right $       TypedValue False (TypeClassDictionaryAccessor className ident) $       moveQuantifiersToFront (quantify (ConstrainedType [(className, map (TypeVar . fst) args)] ty)) typeClassMemberToDictionaryAccessor mn name args (PositionedDeclaration pos com d) =@@ -264,7 +264,7 @@           dictTy = foldl TypeApp (TypeConstructor className) tys           constrainedTy = quantify (if null deps then dictTy else ConstrainedType deps dictTy)           dict = TypeClassDictionaryConstructorApp className props-          result = ValueDeclaration name TypeInstanceDictionaryValue [] (Right (TypedValue True dict constrainedTy))+          result = ValueDeclaration name Private [] (Right (TypedValue True dict constrainedTy))       return result    where@@ -277,7 +277,7 @@    memberToValue :: (Functor m, Applicative m, MonadSupply m, MonadError MultipleErrors m) => [(Ident, Type)] -> Declaration -> Desugar m Expr   memberToValue tys' (ValueDeclaration ident _ [] (Right val)) = do-    _ <- maybe (throwError . errorMessage $ MissingClassMember ident) return $ lookup ident tys'+    _ <- maybe (throwError . errorMessage $ ExtraneousClassMember ident) return $ lookup ident tys'     return val   memberToValue tys' (PositionedDeclaration pos com d) = rethrowWithPosition pos $ do     val <- memberToValue tys' d

src/Language/PureScript/Sugar/TypeDeclarations.hs view

@@ -23,8 +23,7 @@  import Control.Applicative import Control.Monad (forM)-import Control.Monad.Except (throwError)-import Control.Monad.Error.Class (MonadError)+import Control.Monad.Error.Class (MonadError(..))  import Language.PureScript.AST import Language.PureScript.Names

src/Language/PureScript/TypeChecker.hs view

@@ -32,7 +32,7 @@ import qualified Data.Map as M  import Control.Monad.State-import Control.Monad.Except+import Control.Monad.Error.Class (MonadError(..))  import Language.PureScript.Types import Language.PureScript.Names@@ -88,10 +88,10 @@   toPair (PositionedDeclaration _ _ d) = toPair d   toPair _ = error "Invalid declaration in TypeClassDeclaration" -addTypeClassDictionaries :: [TypeClassDictionaryInScope] -> Check ()-addTypeClassDictionaries entries =-  let mentries = M.fromList [ ((canonicalizeDictionary entry, mn), entry) | entry@TypeClassDictionaryInScope{ tcdName = Qualified mn _ } <- entries ]-  in modify $ \st -> st { checkEnv = (checkEnv st) { typeClassDictionaries = (typeClassDictionaries . checkEnv $ st) `M.union` mentries } }+addTypeClassDictionaries :: Maybe ModuleName -> M.Map (Qualified ProperName) (M.Map (Qualified Ident) TypeClassDictionaryInScope) -> Check ()+addTypeClassDictionaries mn entries =+  modify $ \st -> st { checkEnv = (checkEnv st) { typeClassDictionaries = insertState st } }+  where insertState st = M.insertWith (M.unionWith M.union) mn entries (typeClassDictionaries . checkEnv $ st)  checkDuplicateTypeArguments :: [String] -> Check () checkDuplicateTypeArguments args = for_ firstDup $ \dup ->@@ -207,14 +207,14 @@     putEnv $ env { types = M.insert (Qualified (Just moduleName) name) (kind, ExternData) (types env) }     ds <- go rest     return $ d : ds-  go (d@(ExternDeclaration importTy name _ ty) : rest) = do+  go (d@(ExternDeclaration name ty) : rest) = do     rethrow (onErrorMessages (ErrorInForeignImport name)) $ do       env <- getEnv       kind <- kindOf moduleName ty       guardWith (errorMessage (ExpectedType kind)) $ kind == Star       case M.lookup (moduleName, name) (names env) of         Just _ -> throwError . errorMessage $ RedefinedIdent name-        Nothing -> putEnv (env { names = M.insert (moduleName, name) (ty, Extern importTy, Defined) (names env) })+        Nothing -> putEnv (env { names = M.insert (moduleName, name) (ty, External, Defined) (names env) })     ds <- go rest     return $ d : ds   go (d@(FixityDeclaration _ name) : rest) = do@@ -223,13 +223,8 @@     guardWith (errorMessage (OrphanFixityDeclaration name)) $ M.member (moduleName, Op name) $ names env     return $ d : ds   go (d@(ImportDeclaration importedModule _ _) : rest) = do-    tcds <- getTypeClassDictionaries-    let instances = filter (\tcd -> let Qualified (Just mn) _ = tcdName tcd in importedModule == mn) tcds-    addTypeClassDictionaries [ tcd { tcdName = Qualified (Just moduleName) ident, tcdType = TCDAlias (canonicalizeDictionary tcd) }-                             | tcd <- instances-                             , tcdExported tcd-                             , let (Qualified _ ident) = tcdName tcd-                             ]+    instances <- lookupTypeClassDictionaries $ Just importedModule+    addTypeClassDictionaries (Just moduleName) instances     ds <- go rest     return $ d : ds   go (d@(TypeClassDeclaration pn args implies tys) : rest) = do@@ -248,7 +243,8 @@   goInstance d dictName deps className tys rest = do     mapM_ (checkTypeClassInstance moduleName) tys     forM_ deps $ mapM_ (checkTypeClassInstance moduleName) . snd-    addTypeClassDictionaries [TypeClassDictionaryInScope (Qualified (Just moduleName) dictName) className tys (Just deps) TCDRegular isInstanceExported]+    let dict = TypeClassDictionaryInScope (Qualified (Just moduleName) dictName) className tys (Just deps) TCDRegular isInstanceExported+    addTypeClassDictionaries (Just moduleName) . M.singleton className $ M.singleton (canonicalizeDictionary dict) dict     ds <- go rest     return $ d : ds

src/Language/PureScript/TypeChecker/Entailment.hs view

@@ -13,6 +13,8 @@ -- ----------------------------------------------------------------------------- +{-# LANGUAGE GeneralizedNewtypeDeriving #-}+ module Language.PureScript.TypeChecker.Entailment (     entails ) where@@ -25,7 +27,8 @@  import Control.Applicative import Control.Arrow (Arrow(..))-import Control.Monad.Except+import Control.Monad.State+import Control.Monad.Error.Class (MonadError(..))  import Language.PureScript.AST import Language.PureScript.Errors@@ -38,63 +41,72 @@ import Language.PureScript.Types import qualified Language.PureScript.Constants as C +newtype Work = Work Integer deriving (Show, Eq, Ord, Num)+ -- | -- Check that the current set of type class dictionaries entail the specified type class goal, and, if so, -- return a type class dictionary reference. ---entails :: Environment -> ModuleName -> [TypeClassDictionaryInScope] -> Constraint -> Bool -> Check Expr-entails env moduleName context = solve (sortedNubBy canonicalizeDictionary (filter filterModule context))+entails :: Environment -> ModuleName -> M.Map (Maybe ModuleName) (M.Map (Qualified ProperName) (M.Map (Qualified Ident) TypeClassDictionaryInScope)) -> Constraint -> Bool -> Check Expr+entails env moduleName context = solve   where-    sortedNubBy :: (Ord k) => (v -> k) -> [v] -> [v]-    sortedNubBy f vs = M.elems (M.fromList (map (f &&& id) vs))+    forClassName :: Qualified ProperName -> [TypeClassDictionaryInScope]+    forClassName cn = findDicts cn Nothing ++ findDicts cn (Just moduleName) -    -- Filter out type dictionaries which are in scope in the current module-    filterModule :: TypeClassDictionaryInScope -> Bool-    filterModule (TypeClassDictionaryInScope { tcdName = Qualified (Just mn) _ }) | mn == moduleName = True-    filterModule (TypeClassDictionaryInScope { tcdName = Qualified Nothing _ }) = True-    filterModule _ = False+    findDicts :: Qualified ProperName -> Maybe ModuleName -> [TypeClassDictionaryInScope]+    findDicts cn = maybe [] M.elems . (>>= M.lookup cn) . flip M.lookup context -    solve context' (className, tys) trySuperclasses =-      checkOverlaps $ go trySuperclasses className tys+    solve :: Constraint -> Bool -> Check Expr+    solve (className, tys) trySuperclasses = do+      let dicts = flip evalStateT (Work 0) $ go trySuperclasses className tys+      checkOverlaps dicts       where-      go trySuperclasses' className' tys' =-        -- Look for regular type instances-        [ mkDictionary (canonicalizeDictionary tcd) args-        | tcd <- context'-        -- Make sure the type class name matches the one we are trying to satisfy-        , className' == tcdClassName tcd-        -- Make sure the type unifies with the type in the type instance definition-        , subst <- maybeToList . (>>= verifySubstitution) . fmap concat $ zipWithM (typeHeadsAreEqual moduleName env) tys' (tcdInstanceTypes tcd)-        -- Solve any necessary subgoals-        , args <- solveSubgoals subst (tcdDependencies tcd) ] +++      go :: Bool -> Qualified ProperName -> [Type] -> StateT Work [] DictionaryValue+      go trySuperclasses' className' tys' = do+        workDone <- get+        guard $ workDone < 1000+        modify (1 +)+        directInstances <|> superclassInstances+        where+        directInstances :: StateT Work [] DictionaryValue+        directInstances = do+          tcd <- lift $ forClassName className'+          -- Make sure the type unifies with the type in the type instance definition+          subst <- lift . maybeToList . (>>= verifySubstitution) . fmap concat $ zipWithM (typeHeadsAreEqual moduleName env) tys' (tcdInstanceTypes tcd)+          -- Solve any necessary subgoals+          args <- solveSubgoals subst (tcdDependencies tcd)+          return $ mkDictionary (canonicalizeDictionary tcd) args -        -- Look for implementations via superclasses-        [ SubclassDictionaryValue suDict superclass index-        | trySuperclasses'-        , (subclassName, (args, _, implies)) <- M.toList (typeClasses env)-        -- Try each superclass-        , (index, (superclass, suTyArgs)) <- zip [0..] implies-        -- Make sure the type class name matches the superclass name-        , className' == superclass-        -- Make sure the types unify with the types in the superclass implication-        , subst <- maybeToList . (>>= verifySubstitution) . fmap concat $ zipWithM (typeHeadsAreEqual moduleName env) tys' suTyArgs-        -- Finally, satisfy the subclass constraint-        , args' <- maybeToList $ mapM ((`lookup` subst) . fst) args-        , suDict <- go True subclassName args' ]+        superclassInstances :: StateT Work [] DictionaryValue+        superclassInstances = do+          guard trySuperclasses'+          (subclassName, (args, _, implies)) <- lift $ M.toList (typeClasses env)+          -- Try each superclass+          (index, (superclass, suTyArgs)) <- lift $ zip [0..] implies+          -- Make sure the type class name matches the superclass name+          guard $ className' == superclass+          -- Make sure the types unify with the types in the superclass implication+          subst <- lift . maybeToList . (>>= verifySubstitution) . fmap concat $ zipWithM (typeHeadsAreEqual moduleName env) tys' suTyArgs+          -- Finally, satisfy the subclass constraint+          args' <- lift . maybeToList $ mapM ((`lookup` subst) . fst) args+          suDict <- go True subclassName args'+          return $ SubclassDictionaryValue suDict superclass index        -- Create dictionaries for subgoals which still need to be solved by calling go recursively       -- E.g. the goal (Show a, Show b) => Show (Either a b) can be satisfied if the current type       -- unifies with Either a b, and we can satisfy the subgoals Show a and Show b recursively.-      solveSubgoals :: [(String, Type)] -> Maybe [Constraint] -> [Maybe [DictionaryValue]]+      solveSubgoals :: [(String, Type)] -> Maybe [Constraint] -> StateT Work [] (Maybe [DictionaryValue])       solveSubgoals _ Nothing = return Nothing       solveSubgoals subst (Just subgoals) = do         dict <- mapM (uncurry (go True) . second (map (replaceAllTypeVars subst))) subgoals         return $ Just dict+               -- Make a dictionary from subgoal dictionaries by applying the correct function       mkDictionary :: Qualified Ident -> Maybe [DictionaryValue] -> DictionaryValue       mkDictionary fnName Nothing = LocalDictionaryValue fnName       mkDictionary fnName (Just []) = GlobalDictionaryValue fnName       mkDictionary fnName (Just dicts) = DependentDictionaryValue fnName dicts+             -- Turn a DictionaryValue into a Expr       dictionaryValueToValue :: DictionaryValue -> Expr       dictionaryValueToValue (LocalDictionaryValue fnName) = Var fnName@@ -116,7 +128,7 @@       checkOverlaps :: [DictionaryValue] -> Check Expr       checkOverlaps dicts =         case [ (d1, d2) | d1 <- dicts, d2 <- dicts, d1 `overlapping` d2 ] of-          ds@(_ : _) -> throwError . errorMessage $ OverlappingInstances className tys (map fst ds)+          ds@(_ : _) -> throwError . errorMessage $ OverlappingInstances className tys $ nub (map fst ds)           _ -> case chooseSimplestDictionaries dicts of                  [] -> throwError . errorMessage $ NoInstanceFound className tys                  d : _ -> return $ dictionaryValueToValue d

src/Language/PureScript/TypeChecker/Kinds.hs view

@@ -30,7 +30,8 @@  import Control.Arrow (second) import Control.Applicative-import Control.Monad.Except+import Control.Monad+import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.State import Control.Monad.Unify

src/Language/PureScript/TypeChecker/Monad.hs view

@@ -22,16 +22,16 @@ import qualified Data.Map as M  import Control.Applicative-import Control.Monad.Except-import Control.Monad.Reader.Class import Control.Monad.State import Control.Monad.Unify+import Control.Monad.Writer+import Control.Monad.Error.Class (MonadError(..))+import Control.Monad.Trans.Except  import Language.PureScript.Environment import Language.PureScript.Errors import Language.PureScript.Kinds import Language.PureScript.Names-import Language.PureScript.Options import Language.PureScript.TypeClassDictionaries import Language.PureScript.Types @@ -69,24 +69,30 @@ withTypeClassDictionaries :: (MonadState CheckState m) => [TypeClassDictionaryInScope] -> m a -> m a withTypeClassDictionaries entries action = do   orig <- get-  let mentries = M.fromList [ ((canonicalizeDictionary entry, mn), entry) | entry@TypeClassDictionaryInScope{ tcdName = Qualified mn _ }  <- entries ]-  modify $ \st -> st { checkEnv = (checkEnv st) { typeClassDictionaries = (typeClassDictionaries . checkEnv $ st) `M.union` mentries } }+  let mentries = M.fromListWith (M.unionWith M.union) [ (mn, M.singleton className (M.singleton (canonicalizeDictionary entry) entry)) | entry@TypeClassDictionaryInScope{ tcdName = Qualified mn _, tcdClassName = className }  <- entries ]+  modify $ \st -> st { checkEnv = (checkEnv st) { typeClassDictionaries = M.unionWith (M.unionWith M.union) (typeClassDictionaries . checkEnv $ st) mentries } }   a <- action   modify $ \st -> st { checkEnv = (checkEnv st) { typeClassDictionaries = typeClassDictionaries . checkEnv $ orig } }   return a  -- |--- Get the currently available list of type class dictionaries+-- Get the currently available map of type class dictionaries ---getTypeClassDictionaries :: (Functor m, MonadState CheckState m) => m [TypeClassDictionaryInScope]-getTypeClassDictionaries = M.elems . typeClassDictionaries . checkEnv <$> get+getTypeClassDictionaries :: (Functor m, MonadState CheckState m) => m (M.Map (Maybe ModuleName) (M.Map (Qualified ProperName) (M.Map (Qualified Ident) TypeClassDictionaryInScope)))+getTypeClassDictionaries = typeClassDictionaries . checkEnv <$> get  -- |+-- Lookup type class dictionaries in a module.+--+lookupTypeClassDictionaries :: (Functor m, MonadState CheckState m) => Maybe ModuleName -> m (M.Map (Qualified ProperName) (M.Map (Qualified Ident) TypeClassDictionaryInScope))+lookupTypeClassDictionaries mn = fromMaybe M.empty . M.lookup mn . typeClassDictionaries . checkEnv <$> get++-- | -- Temporarily bind a collection of names to local variables -- bindLocalVariables :: (Functor m, MonadState CheckState m) => ModuleName -> [(Ident, Type, NameVisibility)] -> m a -> m a bindLocalVariables moduleName bindings =-  bindNames (M.fromList $ flip map bindings $ \(name, ty, visibility) -> ((moduleName, name), (ty, LocalVariable, visibility)))+  bindNames (M.fromList $ flip map bindings $ \(name, ty, visibility) -> ((moduleName, name), (ty, Private, visibility)))  -- | -- Temporarily bind a collection of names to local type variables@@ -98,12 +104,19 @@ -- | -- Update the visibility of all names to Defined ---makeBindingGroupVisible :: (Functor m, MonadState CheckState m) => m a -> m a-makeBindingGroupVisible action = do-  orig <- get-  modify $ \st -> st { checkEnv = (checkEnv st) { names = M.map (\(ty, nk, _) -> (ty, nk, Defined)) (names . checkEnv $ st) } }+makeBindingGroupVisible :: (Functor m, MonadState CheckState m) => m ()+makeBindingGroupVisible = modifyEnv $ \e -> e { names = M.map (\(ty, nk, _) -> (ty, nk, Defined)) (names e) }++-- | Update the visibility of all names to Defined in the scope of the provided action+withBindingGroupVisible :: (Functor m, MonadState CheckState m) => m a -> m a+withBindingGroupVisible action = preservingNames $ makeBindingGroupVisible >> action++-- | Perform an action while preserving the names from the @Environment@.+preservingNames :: (Functor m, MonadState CheckState m) => m a -> m a+preservingNames action = do+  orig <- gets (names . checkEnv)   a <- action-  modify $ \st -> st { checkEnv = (checkEnv st) { names = names . checkEnv $ orig } }+  modifyEnv $ \e -> e { names = orig }   return a  -- |@@ -171,8 +184,8 @@ -- | -- The type checking monad, which provides the state of the type checker, and error reporting capabilities ---newtype Check a = Check { unCheck :: StateT CheckState (Either MultipleErrors) a }-  deriving (Functor, Monad, Applicative, MonadState CheckState, MonadError MultipleErrors)+newtype Check a = Check { unCheck :: StateT CheckState (ExceptT MultipleErrors (Writer MultipleErrors)) a }+  deriving (Functor, Monad, Applicative, MonadState CheckState, MonadError MultipleErrors, MonadWriter MultipleErrors)  -- | -- Get the current @Environment@@@ -195,17 +208,25 @@ -- | -- Run a computation in the Check monad, starting with an empty @Environment@ ---runCheck :: (MonadReader (Options mode) m, MonadError String m) => Check a -> m (a, Environment)+runCheck :: (MonadError MultipleErrors m, MonadWriter MultipleErrors m) => Check a -> m (a, Environment) runCheck = runCheck' initEnvironment  -- | -- Run a computation in the Check monad, failing with an error, or succeeding with a return value and the final @Environment@. ---runCheck' :: (MonadReader (Options mode) m, MonadError String m) => Environment -> Check a -> m (a, Environment)-runCheck' env c = do-  verbose <- asks optionsVerboseErrors-  interpretMultipleErrors verbose $ do-    (a, s) <- flip runStateT (CheckState env 0 0 Nothing) $ unCheck c+runCheck' :: (MonadError MultipleErrors m, MonadWriter MultipleErrors m) => Environment -> Check a -> m (a, Environment)+runCheck' env = interpretMultipleErrorsAndWarnings . unwrapCheckWithWarnings env+  where+  unwrapCheckWithWarnings :: Environment -> Check a -> (Either MultipleErrors (a, Environment), MultipleErrors)+  unwrapCheckWithWarnings e =+    (\(rc, w) -> (envCheck rc, w))+    . runWriter+    . runExceptT+    . flip runStateT (CheckState e 0 0 Nothing)+    . unCheck+  envCheck :: Either MultipleErrors (a, CheckState) -> Either MultipleErrors (a, Environment)+  envCheck rc = do+    (a, s) <- rc     return (a, checkEnv s)  -- |@@ -234,8 +255,18 @@ -- Run a computation in the substitution monad, generating a return value and the final substitution. -- liftUnify :: (Partial t) => UnifyT t Check a -> Check (a, Substitution t)-liftUnify unify = do+liftUnify = liftUnifyWarnings (const id)++-- |+-- Run a computation in the substitution monad, generating a return value, the final substitution and updating warnings values.+--+liftUnifyWarnings :: (Partial t) => (Substitution t -> ErrorMessage -> ErrorMessage) -> UnifyT t Check a -> Check (a, Substitution t)+liftUnifyWarnings replace unify = do   st <- get-  (a, ust) <- runUnify (defaultUnifyState { unifyNextVar = checkNextVar st }) unify+  let ru = runUnify (defaultUnifyState { unifyNextVar = checkNextVar st }) unify+  ((a, ust), w) <- censor (const mempty) . listen $ ru   modify $ \st' -> st' { checkNextVar = unifyNextVar ust }-  return (a, unifyCurrentSubstitution ust)+  let uust = unifyCurrentSubstitution ust+  tell $ onErrorMessages (replace uust) w+  return (a, uust)+

src/Language/PureScript/TypeChecker/Rows.hs view

@@ -19,7 +19,8 @@  import Data.List -import Control.Monad.Except+import Control.Monad+import Control.Monad.Error.Class (MonadError(..))  import Language.PureScript.AST import Language.PureScript.Errors

src/Language/PureScript/TypeChecker/Skolems.hs view

@@ -26,7 +26,7 @@ import Data.Monoid  import Control.Applicative-import Control.Monad.Except+import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.Unify  import Language.PureScript.AST@@ -88,7 +88,7 @@   let (_, f, _, _, _) = everythingWithContextOnValues [] [] (++) def go def def def   in case f root of        [] -> return ()-       ((binding, val) : _) -> throwError . errorMessage . ErrorInExpression val $ EscapedSkolem binding+       ((binding, val) : _) -> throwError . singleError $ ErrorInExpression val $ SimpleErrorWrapper $ EscapedSkolem binding   where   def s _ = (s, [])

src/Language/PureScript/TypeChecker/Subsumption.hs view

@@ -20,7 +20,8 @@ import Data.List (sortBy) import Data.Ord (comparing) -import Control.Monad.Except+import Control.Monad+import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.Unify  import Language.PureScript.AST

src/Language/PureScript/TypeChecker/Synonyms.hs view

@@ -28,7 +28,7 @@ import qualified Data.Map as M  import Control.Applicative-import Control.Monad.Except+import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.State  import Language.PureScript.Environment@@ -40,28 +40,22 @@ -- | -- Build a type substitution for a type synonym ---buildTypeSubstitution :: Qualified ProperName -> Int -> Type -> Either ErrorMessage (Maybe Type)-buildTypeSubstitution name n = go n []+buildTypeSubstitution :: M.Map (Qualified ProperName) Int -> Type -> Either ErrorMessage (Maybe Type)+buildTypeSubstitution m = go 0 []   where   go :: Int -> [Type] -> Type -> Either ErrorMessage (Maybe Type)-  go 0 args (TypeConstructor ctor) | name == ctor = return (Just $ SaturatedTypeSynonym ctor args)-  go m _ (TypeConstructor ctor) | m > 0 && name == ctor = throwError $ PartiallyAppliedSynonym name-  go m args (TypeApp f arg) = go (m - 1) (arg:args) f+  go c args (TypeConstructor ctor) | M.lookup ctor m == Just c = return (Just $ SaturatedTypeSynonym ctor args)+  go c _    (TypeConstructor ctor) | M.lookup ctor m >  Just c = throwError $ SimpleErrorWrapper $ PartiallyAppliedSynonym ctor+  go c args (TypeApp f arg) = go (c + 1) (arg:args) f   go _ _ _ = return Nothing  -- |--- Replace all instances of a specific type synonym with the @SaturatedTypeSynonym@ data constructor----saturateTypeSynonym :: Qualified ProperName -> Int -> Type -> Either ErrorMessage Type-saturateTypeSynonym name n = everywhereOnTypesTopDownM replace-  where-  replace t = fromMaybe t <$> buildTypeSubstitution name n t---- | -- Replace all type synonyms with the @SaturatedTypeSynonym@ data constructor ---saturateAllTypeSynonyms :: [(Qualified ProperName, Int)] -> Type -> Either ErrorMessage Type-saturateAllTypeSynonyms syns d = foldM (\result (name, n) -> saturateTypeSynonym name n result) d syns+saturateAllTypeSynonyms :: M.Map (Qualified ProperName) Int -> Type -> Either ErrorMessage Type+saturateAllTypeSynonyms syns = everywhereOnTypesTopDownM replace+  where+  replace t = fromMaybe t <$> buildTypeSubstitution syns t  -- | -- \"Desaturate\" @SaturatedTypeSynonym@s@@ -79,14 +73,14 @@ replaceAllTypeSynonyms' :: Environment -> Type -> Either ErrorMessage Type replaceAllTypeSynonyms' env d =   let-    syns = map (\(name, (args, _)) -> (name, length args)) . M.toList $ typeSynonyms env+    syns = length . fst <$> typeSynonyms env   in     saturateAllTypeSynonyms syns d  replaceAllTypeSynonyms :: (e ~ MultipleErrors, Functor m, Monad m, MonadState CheckState m, MonadError e m) => Type -> m Type replaceAllTypeSynonyms d = do   env <- getEnv-  either (throwError . errorMessage) return $ replaceAllTypeSynonyms' env d+  either (throwError . singleError) return $ replaceAllTypeSynonyms' env d  -- | -- Replace a type synonym and its arguments with the aliased type@@ -102,7 +96,7 @@ expandTypeSynonym :: (e ~ MultipleErrors, Functor m, Monad m, MonadState CheckState m, MonadError e m) => Qualified ProperName -> [Type] -> m Type expandTypeSynonym name args = do   env <- getEnv-  either (throwError . errorMessage) return $ expandTypeSynonym' env name args+  either (throwError . singleError) return $ expandTypeSynonym' env name args  expandAllTypeSynonyms :: (e ~ MultipleErrors, Functor m, Applicative m, Monad m, MonadState CheckState m, MonadError e m) => Type -> m Type expandAllTypeSynonyms = everywhereOnTypesTopDownM go

src/Language/PureScript/TypeChecker/Types.hs view

@@ -41,9 +41,10 @@ import qualified Data.Map as M  import Control.Applicative-import Control.Monad.Except+import Control.Monad import Control.Monad.State import Control.Monad.Unify+import Control.Monad.Error.Class (MonadError(..))  import Language.PureScript.AST import Language.PureScript.Environment@@ -69,7 +70,7 @@ -- typesOf :: Maybe ModuleName -> ModuleName -> [(Ident, Expr)] -> Check [(Ident, (Expr, Type))] typesOf mainModuleName moduleName vals = do-  tys <- fmap tidyUp . liftUnify $ do+  tys <- fmap tidyUp . liftUnifyWarnings replace $ do     (untyped, typed, dict, untypedDict) <- typeDictionaryForBindingGroup moduleName vals     ds1 <- parU typed $ \e -> do       triple@(_, (_, ty)) <- checkTypedBindingGroupElement moduleName e dict@@ -96,6 +97,9 @@   where   -- Apply the substitution that was returned from runUnify to both types and (type-annotated) values   tidyUp (ts, sub) = map (\(i, (val, ty)) -> (i, (overTypes (sub $?) val, sub $? ty))) ts+  -- Replace all the wildcards types with their inferred types+  replace sub (SimpleErrorWrapper (WildcardInferredType ty)) = SimpleErrorWrapper $ WildcardInferredType (sub $? ty)+  replace _ em = em   -- If --main is enabled, need to check that `main` has type Eff eff a for some eff, a   checkMain nm ty = when (Just moduleName == mainModuleName && nm == Ident C.main) $ do     [eff, a] <- replicateM 2 fresh@@ -123,7 +127,7 @@     -- Make a map of names to the unification variables of untyped declarations     untypedDict = zip (map fst untyped) untypedNames     -- Create the dictionary of all name/type pairs, which will be added to the environment during type checking-    dict = M.fromList (map (\(ident, ty) -> ((moduleName, ident), (ty, LocalVariable, Undefined))) $ typedDict ++ untypedDict)+    dict = M.fromList (map (\(ident, ty) -> ((moduleName, ident), (ty, Private, Undefined))) $ typedDict ++ untypedDict)   return (untyped, typed, dict, untypedDict)  checkTypedBindingGroupElement :: ModuleName -> (Ident, (Expr, Type, Bool)) -> TypeData ->  UnifyT Type Check (Ident, (Expr, Type))@@ -211,8 +215,10 @@ -- Infer a type for a value -- infer' :: Expr -> UnifyT Type Check Expr-infer' v@(NumericLiteral _) = return $ TypedValue True v tyNumber+infer' v@(NumericLiteral (Left _)) = return $ TypedValue True v tyInt+infer' v@(NumericLiteral (Right _)) = return $ TypedValue True v tyNumber infer' v@(StringLiteral _) = return $ TypedValue True v tyString+infer' v@(CharLiteral _) = return $ TypedValue True v tyChar infer' v@(BooleanLiteral _) = return $ TypedValue True v tyBoolean infer' (ArrayLiteral vals) = do   ts <- mapM infer vals@@ -247,7 +253,7 @@ infer' (Abs (Left arg) ret) = do   ty <- fresh   Just moduleName <- checkCurrentModule <$> get-  makeBindingGroupVisible $ bindLocalVariables moduleName [(arg, ty, Defined)] $ do+  withBindingGroupVisible $ bindLocalVariables moduleName [(arg, ty, Defined)] $ do     body@(TypedValue _ _ bodyTy) <- infer' ret     return $ TypedValue True (Abs (Left arg) body) $ function ty bodyTy infer' (Abs (Right _) _) = error "Binder was not desugared"@@ -298,7 +304,7 @@ infer' _ = error "Invalid argument to infer"  inferLetBinding :: [Declaration] -> [Declaration] -> Expr -> (Expr -> UnifyT Type Check Expr) -> UnifyT Type Check ([Declaration], Expr)-inferLetBinding seen [] ret j = (,) seen <$> makeBindingGroupVisible (j ret)+inferLetBinding seen [] ret j = (,) seen <$> withBindingGroupVisible (j ret) inferLetBinding seen (ValueDeclaration ident nameKind [] (Right (tv@(TypedValue checkType val ty))) : rest) ret j = do   Just moduleName <- checkCurrentModule <$> get   (kind, args) <- liftCheck $ kindOfWithScopedVars ty@@ -319,8 +325,10 @@   (untyped, typed, dict, untypedDict) <- typeDictionaryForBindingGroup moduleName (map (\(i, _, v) -> (i, v)) ds)   ds1' <- parU typed $ \e -> checkTypedBindingGroupElement moduleName e dict   ds2' <- forM untyped $ \e -> typeForBindingGroupElement e dict untypedDict-  let ds' = [(ident, LocalVariable, val') | (ident, (val', _)) <- ds1' ++ ds2']-  makeBindingGroupVisible $ bindNames dict $ inferLetBinding (seen ++ [BindingGroupDeclaration ds']) rest ret j+  let ds' = [(ident, Private, val') | (ident, (val', _)) <- ds1' ++ ds2']+  bindNames dict $ do+    makeBindingGroupVisible+    inferLetBinding (seen ++ [BindingGroupDeclaration ds']) rest ret j inferLetBinding seen (PositionedDeclaration pos com d : ds) ret j = rethrowWithPosition pos $ do   (d' : ds', val') <- inferLetBinding seen (d : ds) ret j   return (PositionedDeclaration pos com d' : ds', val')@@ -347,7 +355,9 @@ inferBinder :: Type -> Binder -> UnifyT Type Check (M.Map Ident Type) inferBinder _ NullBinder = return M.empty inferBinder val (StringBinder _) = val =?= tyString >> return M.empty-inferBinder val (NumberBinder _) = val =?= tyNumber >> return M.empty+inferBinder val (CharBinder _) = val =?= tyChar >> return M.empty+inferBinder val (NumberBinder (Left _)) = val =?= tyInt >> return M.empty+inferBinder val (NumberBinder (Right _)) = val =?= tyNumber >> return M.empty inferBinder val (BooleanBinder _) = val =?= tyBoolean >> return M.empty inferBinder val (VarBinder name) = return $ M.singleton name val inferBinder val (ConstructorBinder ctor binders) = do@@ -358,12 +368,15 @@       fn' <- introduceSkolemScope <=< replaceAllTypeSynonyms $ fn       go binders fn'         where-        go [] ty' = do-          _ <- subsumes Nothing val ty'-          return M.empty+        go [] ty' = case (val, ty') of+          (TypeConstructor _, TypeApp _ _) -> throwIncorrectArity+          _ -> do+            _ <- subsumes Nothing val ty'+            return M.empty         go (binder : binders') (TypeApp (TypeApp t obj) ret) | t == tyFunction =           M.union <$> inferBinder obj binder <*> go binders' ret-        go _ _ = throwError . errorMessage $ IncorrectConstructorArity ctor+        go _ _ = throwIncorrectArity+        throwIncorrectArity = throwError . errorMessage $ IncorrectConstructorArity ctor     _ -> throwError . errorMessage $ UnknownDataConstructor ctor Nothing inferBinder val (ObjectBinder props) = do   row <- fresh@@ -384,12 +397,6 @@   m1 <- M.unions <$> mapM (inferBinder el) binders   val =?= TypeApp tyArray el   return m1-inferBinder val (ConsBinder headBinder tailBinder) = do-  el <- fresh-  m1 <- inferBinder el headBinder-  m2 <- inferBinder val tailBinder-  val =?= TypeApp tyArray el-  return $ m1 `M.union` m2 inferBinder val (NamedBinder name binder) = do   m <- inferBinder val binder   return $ M.insert name val m@@ -442,7 +449,7 @@   dictNames <- forM constraints $ \(Qualified _ (ProperName className), _) -> do     n <- liftCheck freshDictionaryName     return $ Ident $ "__dict_" ++ className ++ "_" ++ show n-  val' <- makeBindingGroupVisible $ withTypeClassDictionaries (zipWith (\name (className, instanceTy) ->+  val' <- withBindingGroupVisible $ withTypeClassDictionaries (zipWith (\name (className, instanceTy) ->     TypeClassDictionaryInScope name className instanceTy Nothing TCDRegular False) (map (Qualified Nothing) dictNames)       constraints) $ check val ty   return $ TypedValue True (foldr (Abs . Left) val' dictNames) t@@ -455,10 +462,14 @@   (val'', ty') <- instantiatePolyTypeWithUnknowns val' ty   ty' =?= u   return $ TypedValue True val'' ty'-check' v@(NumericLiteral _) t | t == tyNumber =+check' v@(NumericLiteral (Left _)) t | t == tyInt =   return $ TypedValue True v t+check' v@(NumericLiteral (Right _)) t | t == tyNumber =+  return $ TypedValue True v t check' v@(StringLiteral _) t | t == tyString =   return $ TypedValue True v t+check' v@(CharLiteral _) t | t == tyChar =+  return $ TypedValue True v t check' v@(BooleanLiteral _) t | t == tyBoolean =   return $ TypedValue True v t check' (ArrayLiteral vals) t@(TypeApp a ty) = do@@ -468,7 +479,7 @@ check' (Abs (Left arg) ret) ty@(TypeApp (TypeApp t argTy) retTy) = do   t =?= tyFunction   Just moduleName <- checkCurrentModule <$> get-  ret' <- makeBindingGroupVisible $ bindLocalVariables moduleName [(arg, argTy, Defined)] $ check ret retTy+  ret' <- withBindingGroupVisible $ bindLocalVariables moduleName [(arg, argTy, Defined)] $ check ret retTy   return $ TypedValue True (Abs (Left arg) ret') ty check' (Abs (Right _) _) _ = error "Binder was not desugared" check' (App f arg) ret = do

src/Language/PureScript/TypeChecker/Unify.hs view

@@ -29,8 +29,10 @@ import Data.Maybe (fromMaybe) import qualified Data.HashMap.Strict as H -import Control.Monad.Except+import Control.Monad import Control.Monad.Unify+import Control.Monad.Writer+import Control.Monad.Error.Class (MonadError(..))  import Language.PureScript.Environment import Language.PureScript.Errors@@ -186,6 +188,7 @@   where   replace TypeWildcard = do     u <- fresh'+    liftCheck . tell $ errorMessage . WildcardInferredType $ TUnknown u     return $ TUnknown u   replace other = return other

src/Language/PureScript/Types.hs view

@@ -14,11 +14,15 @@ -----------------------------------------------------------------------------  {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TemplateHaskell #-}  module Language.PureScript.Types where  import Data.Data import Data.List (nub)+import qualified Data.Aeson as A+import qualified Data.Aeson.TH as A  import Control.Monad.Unify import Control.Arrow (second)@@ -32,7 +36,7 @@ -- | -- An identifier for the scope of a skolem variable ---newtype SkolemScope = SkolemScope { runSkolemScope :: Int } deriving (Show, Eq, Ord, Data, Typeable)+newtype SkolemScope = SkolemScope { runSkolemScope :: Int } deriving (Show, Eq, Ord, Data, Typeable, A.ToJSON, A.FromJSON)  -- | -- The type of types@@ -94,21 +98,19 @@   -- |   -- A placeholder used in pretty printing   ---  | PrettyPrintArray Type-  -- |-  -- A placeholder used in pretty printing-  --   | PrettyPrintObject Type   -- |   -- A placeholder used in pretty printing   ---  | PrettyPrintForAll [String] Type deriving (Show, Eq, Data, Typeable)+  | PrettyPrintForAll [String] Type deriving (Show, Eq, Ord, Data, Typeable)  -- | -- A typeclass constraint -- type Constraint = (Qualified ProperName, [Type]) +$(A.deriveJSON A.defaultOptions ''Type)+ -- | -- Convert a row to a list of pairs of labels and types --@@ -248,7 +250,6 @@   go (RCons name ty rest) = f (RCons name (go ty) (go rest))   go (KindedType ty k) = f (KindedType (go ty) k)   go (PrettyPrintFunction t1 t2) = f (PrettyPrintFunction (go t1) (go t2))-  go (PrettyPrintArray t) = f (PrettyPrintArray (go t))   go (PrettyPrintObject t) = f (PrettyPrintObject (go t))   go (PrettyPrintForAll args t) = f (PrettyPrintForAll args (go t))   go other = f other@@ -263,7 +264,6 @@   go (RCons name ty rest) = RCons name (go (f ty)) (go (f rest))   go (KindedType ty k) = KindedType (go (f ty)) k   go (PrettyPrintFunction t1 t2) = PrettyPrintFunction (go (f t1)) (go (f t2))-  go (PrettyPrintArray t) = PrettyPrintArray (go (f t))   go (PrettyPrintObject t) = PrettyPrintObject (go (f t))   go (PrettyPrintForAll args t) = PrettyPrintForAll args (go (f t))   go other = f other@@ -278,7 +278,6 @@   go (RCons name ty rest) = (RCons name <$> go ty <*> go rest) >>= f   go (KindedType ty k) = (KindedType <$> go ty <*> pure k) >>= f   go (PrettyPrintFunction t1 t2) = (PrettyPrintFunction <$> go t1 <*> go t2) >>= f-  go (PrettyPrintArray t) = (PrettyPrintArray <$> go t) >>= f   go (PrettyPrintObject t) = (PrettyPrintObject <$> go t) >>= f   go (PrettyPrintForAll args t) = (PrettyPrintForAll args <$> go t) >>= f   go other = f other@@ -293,7 +292,6 @@   go (RCons name ty rest) = RCons name <$> (f ty >>= go) <*> (f rest >>= go)   go (KindedType ty k) = KindedType <$> (f ty >>= go) <*> pure k   go (PrettyPrintFunction t1 t2) = PrettyPrintFunction <$> (f t1 >>= go) <*> (f t2 >>= go)-  go (PrettyPrintArray t) = PrettyPrintArray <$> (f t >>= go)   go (PrettyPrintObject t) = PrettyPrintObject <$> (f t >>= go)   go (PrettyPrintForAll args t) = PrettyPrintForAll args <$> (f t >>= go)   go other = f other@@ -308,7 +306,6 @@   go t@(RCons _ ty rest) = f t <> go ty <> go rest   go t@(KindedType ty _) = f t <> go ty   go t@(PrettyPrintFunction t1 t2) = f t <> go t1 <> go t2-  go t@(PrettyPrintArray t1) = f t <> go t1   go t@(PrettyPrintObject t1) = f t <> go t1   go t@(PrettyPrintForAll _ t1) = f t <> go t1   go other = f other

tests/Main.hs view

@@ -12,97 +12,175 @@ -- ----------------------------------------------------------------------------- -{-# LANGUAGE DataKinds, DoAndIfThenElse #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DoAndIfThenElse #-} +{-# LANGUAGE TupleSections #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleInstances #-}  module Main (main) where  import qualified Language.PureScript as P+import qualified Language.PureScript.CodeGen.JS as J+import qualified Language.PureScript.CoreFn as CF  import Data.List (isSuffixOf) import Data.Traversable (traverse)+import Data.Time.Clock (UTCTime())++import qualified Data.Map as M+ import Control.Monad-import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)-import Control.Monad.Reader (runReaderT)+import Control.Monad.IO.Class (liftIO) import Control.Applicative++import Control.Monad.Reader+import Control.Monad.Writer+import Control.Monad.Trans.Maybe+import Control.Monad.Trans.Except+import Control.Monad.Error.Class+ import System.Exit import System.Process-import System.FilePath (pathSeparator)-import System.Directory (getCurrentDirectory, getTemporaryDirectory, getDirectoryContents, findExecutable)+import System.FilePath+import System.Directory+ import Text.Parsec (ParseError) +modulesDir :: FilePath+modulesDir = ".test_modules" </> "node_modules"++newtype Test a = Test { unTest :: ReaderT P.Options (WriterT P.MultipleErrors (ExceptT P.MultipleErrors IO)) a }+  deriving (Functor, Applicative, Monad, MonadIO, MonadError P.MultipleErrors, MonadWriter P.MultipleErrors, MonadReader P.Options)++runTest :: Test a -> IO (Either P.MultipleErrors a)+runTest = runExceptT . fmap fst . runWriterT . flip runReaderT P.defaultOptions . unTest++makeActions :: M.Map P.ModuleName (FilePath, P.ForeignJS) -> P.MakeActions Test+makeActions foreigns = P.MakeActions getInputTimestamp getOutputTimestamp readExterns codegen progress+  where+  getInputTimestamp :: P.ModuleName -> Test (Either P.RebuildPolicy (Maybe UTCTime))+  getInputTimestamp mn +    | isPreludeModule (P.runModuleName mn) = return (Left P.RebuildNever)+    | otherwise = return (Left P.RebuildAlways)+    where+    isPreludeModule = flip elem+      [ "Prelude.Unsafe"+      , "Prelude"+      , "Data.Function"+      , "Control.Monad.Eff"+      , "Control.Monad.ST"+      , "Debug.Trace"+      , "Assert"+      ]+  +  getOutputTimestamp :: P.ModuleName -> Test (Maybe UTCTime)+  getOutputTimestamp mn = do+    let filePath = modulesDir </> P.runModuleName mn+    exists <- liftIO $ doesDirectoryExist filePath+    return (if exists then Just (error "getOutputTimestamp: read timestamp") else Nothing)+  +  readExterns :: P.ModuleName -> Test (FilePath, String)+  readExterns mn = do+    let filePath = modulesDir </> P.runModuleName mn </> "externs.purs"+    (filePath, ) <$> readTextFile filePath+  +  codegen :: CF.Module CF.Ann -> P.Environment -> P.SupplyVar -> P.Externs -> Test ()+  codegen m _ nextVar exts = do+    let mn = CF.moduleName m+    foreignInclude <- case (CF.moduleName m `M.lookup` foreigns, CF.moduleForeign m) of+      (Just _, [])   -> error "Unnecessary foreign module"+      (Just path, _) -> return $ Just $ J.JSApp (J.JSVar "require") [J.JSStringLiteral "./foreign"]+      (Nothing, [])  -> return Nothing+      (Nothing, _)   -> error "Missing foreign module"+    pjs <- P.evalSupplyT nextVar $ P.prettyPrintJS <$> J.moduleToJs m foreignInclude+    let filePath    = P.runModuleName $ CF.moduleName m+        jsFile      = modulesDir </> filePath </> "index.js"+        externsFile = modulesDir </> filePath </> "externs.purs"+        foreignFile = modulesDir </> filePath </> "foreign.js"+    writeTextFile jsFile pjs+    maybe (return ()) (writeTextFile foreignFile . snd) $ CF.moduleName m `M.lookup` foreigns+    writeTextFile externsFile exts+    +  readTextFile :: FilePath -> Test String+  readTextFile path = liftIO $ readFile path+  +  writeTextFile :: FilePath -> String -> Test ()+  writeTextFile path text = liftIO $ do+    createDirectoryIfMissing True (takeDirectory path)+    writeFile path text+  +  progress :: String -> Test ()+  progress = liftIO . putStrLn+ readInput :: [FilePath] -> IO [(FilePath, String)] readInput inputFiles = forM inputFiles $ \inputFile -> do   text <- readFile inputFile   return (inputFile, text) -loadPrelude :: Either String (String, String, P.Environment)-loadPrelude =-  case P.parseModulesFromFiles id [("", P.prelude)] of-    Left parseError -> Left (show parseError)-    Right ms -> runReaderT (P.compile (map snd ms) []) $ P.defaultCompileOptions { P.optionsAdditional = P.CompileOptions "Tests" [] [] }--compile :: P.Options P.Compile -> [FilePath] -> IO (Either String (String, String, P.Environment))-compile opts inputFiles = do-  modules <- P.parseModulesFromFiles id <$> readInput inputFiles-  case modules of-    Left parseError ->-      return (Left $ show parseError)-    Right ms -> return $ runReaderT (P.compile (map snd ms) []) opts+compile :: [FilePath] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> IO (Either P.MultipleErrors P.Environment)+compile inputFiles foreigns = runTest $ do+  fs <- liftIO $ readInput inputFiles+  ms <- P.parseModulesFromFiles id fs+  P.make (makeActions foreigns) (map (\(k, v) -> (Right k, v)) ms) -assert :: FilePath -> P.Options P.Compile -> FilePath -> (Either String (String, String, P.Environment) -> IO (Maybe String)) -> IO ()-assert preludeExterns opts inputFile f = do-  e <- compile opts [preludeExterns, inputFile]+assert :: [FilePath] -> +          M.Map P.ModuleName (FilePath, P.ForeignJS) -> +          (Either P.MultipleErrors P.Environment -> IO (Maybe String)) -> +          IO ()+assert inputFiles foreigns f = do+  e <- compile inputFiles foreigns   maybeErr <- f e   case maybeErr of     Just err -> putStrLn err >> exitFailure     Nothing -> return () -assertCompiles :: String -> FilePath -> FilePath -> IO ()-assertCompiles preludeJs preludeExterns inputFile = do-  putStrLn $ "Assert " ++ inputFile ++ " compiles successfully"-  let options = P.defaultCompileOptions-                              { P.optionsMain = Just "Main"-                              , P.optionsAdditional = P.CompileOptions "Tests" ["Main"] ["Main"]-                              }-  assert preludeExterns options inputFile $ either (return . Just) $ \(js, _, _) -> do-    process <- findNodeProcess-    result <- traverse (\node -> readProcessWithExitCode node [] (preludeJs ++ js)) process-    case result of-      Just (ExitSuccess, out, _) -> putStrLn out >> return Nothing-      Just (ExitFailure _, _, err) -> return $ Just err-      Nothing -> return $ Just "Couldn't find node.js executable"+assertCompiles :: [FilePath] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> IO ()+assertCompiles inputFiles foreigns = do+  putStrLn $ "Assert " ++ last inputFiles ++ " compiles successfully"+  assert inputFiles foreigns $ \e ->+    case e of +      Left errs -> return . Just . P.prettyPrintMultipleErrors False $ errs+      Right _ -> do+        process <- findNodeProcess+        let entryPoint = modulesDir </> "index.js"+        writeFile entryPoint "require('Main').main()"+        result <- traverse (\node -> readProcessWithExitCode node [entryPoint] "") process+        case result of+          Just (ExitSuccess, out, _) -> putStrLn out >> return Nothing+          Just (ExitFailure _, _, err) -> return $ Just err+          Nothing -> return $ Just "Couldn't find node.js executable" -assertDoesNotCompile :: FilePath -> FilePath -> IO ()-assertDoesNotCompile preludeExterns inputFile = do-  putStrLn $ "Assert " ++ inputFile ++ " does not compile"-  assert preludeExterns (P.defaultCompileOptions { P.optionsAdditional = P.CompileOptions "Tests" [] [] }) inputFile $ \e ->+assertDoesNotCompile :: [FilePath] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> IO ()+assertDoesNotCompile inputFiles foreigns = do+  putStrLn $ "Assert " ++ last inputFiles ++ " does not compile"+  assert inputFiles foreigns $ \e ->     case e of-      Left err -> putStrLn err >> return Nothing+      Left errs -> putStrLn  (P.prettyPrintMultipleErrors False errs) >> return Nothing       Right _ -> return $ Just "Should not have compiled"  findNodeProcess :: IO (Maybe String) findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names-    where names = ["nodejs", "node"]+  where +  names = ["nodejs", "node"]  main :: IO () main = do-  putStrLn "Compiling Prelude"-  case loadPrelude of-    Left err -> putStrLn err >> exitFailure-    Right (preludeJs, exts, _) -> do-      tmp <- getTemporaryDirectory-      let preludeExterns = tmp ++ pathSeparator : "prelude.externs"-      writeFile preludeExterns exts-      putStrLn $ "Wrote " ++ preludeExterns-      cd <- getCurrentDirectory-      let examples = cd ++ pathSeparator : "examples"-      let passing = examples ++ pathSeparator : "passing"-      passingTestCases <- getDirectoryContents passing-      forM_ passingTestCases $ \inputFile -> when (".purs" `isSuffixOf` inputFile) $-        assertCompiles preludeJs preludeExterns (passing ++ pathSeparator : inputFile)-      let failing = examples ++ pathSeparator : "failing"-      failingTestCases <- getDirectoryContents failing-      forM_ failingTestCases $ \inputFile -> when (".purs" `isSuffixOf` inputFile) $-        assertDoesNotCompile preludeExterns (failing ++ pathSeparator : inputFile)-      exitSuccess-+  cwd <- getCurrentDirectory+  +  let preludeDir  = cwd </> "tests" </> "prelude"+      preludePurs = preludeDir </> "Prelude.purs"+      jsDir       = preludeDir </> "js"+  jsFiles <- map (jsDir </>) . filter (".js" `isSuffixOf`) <$> getDirectoryContents jsDir+  foreignFiles <- forM jsFiles (\f -> (f,) <$> readFile f)+  Right (foreigns, _) <- runExceptT $ runWriterT $ P.parseForeignModulesFromFiles foreignFiles+  +  let passing = cwd </> "examples" </> "passing"+  passingTestCases <- getDirectoryContents passing+  forM_ passingTestCases $ \inputFile -> when (".purs" `isSuffixOf` inputFile) $+    assertCompiles [preludePurs, passing </> inputFile] foreigns+  let failing = cwd </> "examples" </> "failing"+  failingTestCases <- getDirectoryContents failing+  forM_ failingTestCases $ \inputFile -> when (".purs" `isSuffixOf` inputFile) $+    assertDoesNotCompile [preludePurs, failing </> inputFile] foreigns+  exitSuccess