summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPhilFreeman <>2016-02-29 19:32:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2016-02-29 19:32:00 (GMT)
commit0bdc658bac6649643d96d50c5803c123273de9af (patch)
tree5774b31aae641105077d47e0dd3205fa471d1562
parentfd637969029015423133d358a637b35d9e3122cf (diff)
version 0.8.2.00.8.2.0
-rw-r--r--purescript.cabal2
-rw-r--r--src/Language/PureScript/Linter/Exhaustive.hs8
-rw-r--r--src/Language/PureScript/Linter/Imports.hs13
-rw-r--r--src/Language/PureScript/Pretty/Values.hs32
4 files changed, 43 insertions, 12 deletions
diff --git a/purescript.cabal b/purescript.cabal
index dd4cf02..e2da1cf 100644
--- a/purescript.cabal
+++ b/purescript.cabal
@@ -1,5 +1,5 @@
name: purescript
-version: 0.8.1.0
+version: 0.8.2.0
cabal-version: >=1.8
build-type: Simple
license: MIT
diff --git a/src/Language/PureScript/Linter/Exhaustive.hs b/src/Language/PureScript/Linter/Exhaustive.hs
index b28905b..8ccfc6e 100644
--- a/src/Language/PureScript/Linter/Exhaustive.hs
+++ b/src/Language/PureScript/Linter/Exhaustive.hs
@@ -201,9 +201,11 @@ isExhaustiveGuard :: Either [(Guard, Expr)] Expr -> Bool
isExhaustiveGuard (Left gs) = not . null $ filter (\(g, _) -> isOtherwise g) gs
where
isOtherwise :: Expr -> Bool
- isOtherwise (TypedValue _ (BooleanLiteral True) _) = True
- isOtherwise (TypedValue _ (Var (Qualified (Just (ModuleName [ProperName "Prelude"])) (Ident "otherwise"))) _) = True
- isOtherwise (TypedValue _ (Var (Qualified (Just (ModuleName [ProperName "Data", ProperName "Boolean"])) (Ident "otherwise"))) _) = True
+ isOtherwise (BooleanLiteral True) = True
+ isOtherwise (Var (Qualified (Just (ModuleName [ProperName "Prelude"])) (Ident "otherwise"))) = True
+ isOtherwise (Var (Qualified (Just (ModuleName [ProperName "Data", ProperName "Boolean"])) (Ident "otherwise"))) = True
+ isOtherwise (TypedValue _ e _) = isOtherwise e
+ isOtherwise (PositionedValue _ _ e) = isOtherwise e
isOtherwise _ = False
isExhaustiveGuard (Right _) = True
diff --git a/src/Language/PureScript/Linter/Imports.hs b/src/Language/PureScript/Linter/Imports.hs
index 68753b2..63fccba 100644
--- a/src/Language/PureScript/Linter/Imports.hs
+++ b/src/Language/PureScript/Linter/Imports.hs
@@ -79,8 +79,8 @@ lintImports (Module _ _ mn mdecls mexports) env usedImps = do
let scope = maybe nullImports (\(_, imps, _) -> imps) (M.lookup mn env)
usedImps' = foldr (elaborateUsed scope) usedImps exportedModules
- numImplicitImports = getSum $ foldMap (Sum . countImplicitImports) mdecls
- allowImplicit = numImplicitImports == 1
+ numOpenImports = getSum $ foldMap (Sum . countOpenImports) mdecls
+ allowImplicit = numOpenImports == 1
imps <- M.toAscList <$> findImports mdecls
@@ -106,10 +106,11 @@ lintImports (Module _ _ mn mdecls mexports) env usedImps = do
where
- countImplicitImports :: Declaration -> Int
- countImplicitImports (ImportDeclaration mn' Implicit _ _) | not (isPrim mn') = 1
- countImplicitImports (PositionedDeclaration _ _ d) = countImplicitImports d
- countImplicitImports _ = 0
+ countOpenImports :: Declaration -> Int
+ countOpenImports (ImportDeclaration mn' Implicit Nothing _) | not (isPrim mn') = 1
+ countOpenImports (ImportDeclaration mn' (Hiding _) Nothing _) | not (isPrim mn') = 1
+ countOpenImports (PositionedDeclaration _ _ d) = countOpenImports d
+ countOpenImports _ = 0
-- Checks whether a module is the Prim module - used to suppress any checks
-- made, as Prim is always implicitly imported.
diff --git a/src/Language/PureScript/Pretty/Values.hs b/src/Language/PureScript/Pretty/Values.hs
index 867e6f5..b1ab730 100644
--- a/src/Language/PureScript/Pretty/Values.hs
+++ b/src/Language/PureScript/Pretty/Values.hs
@@ -57,6 +57,7 @@ prettyPrintValue d (Accessor prop val) = prettyPrintValueAtom (d - 1) val <> tex
prettyPrintValue d (ObjectUpdate o ps) = prettyPrintValueAtom (d - 1) o <> text " " <> list '{' '}' (\(key, val) -> text (key ++ " = ") <> prettyPrintValue (d - 1) val) ps
prettyPrintValue d (App val arg) = prettyPrintValueAtom (d - 1) val `beforeWithSpace` prettyPrintValueAtom (d - 1) arg
prettyPrintValue d (Abs (Left arg) val) = text ('\\' : showIdent arg ++ " -> ") // moveRight 2 (prettyPrintValue (d - 1) val)
+prettyPrintValue d (Abs (Right arg) val) = text ('\\' : prettyPrintBinder arg ++ " -> ") // moveRight 2 (prettyPrintValue (d - 1) val)
prettyPrintValue d (TypeClassDictionaryConstructorApp className ps) =
text (runProperName (disqualify className) ++ " ") <> prettyPrintValueAtom (d - 1) ps
prettyPrintValue d (Case values binders) =
@@ -70,9 +71,24 @@ prettyPrintValue d (Do els) =
text "do " <> vcat left (map (prettyPrintDoNotationElement (d - 1)) els)
prettyPrintValue _ (TypeClassDictionary (name, tys) _) = foldl1 beforeWithSpace $ text ("#dict " ++ runProperName (disqualify name)) : map typeAtomAsBox tys
prettyPrintValue _ (SuperClassDictionary name _) = text $ "#dict " ++ runProperName (disqualify name)
+prettyPrintValue _ (TypeClassDictionaryAccessor className ident) =
+ text "#dict-accessor " <> text (runProperName (disqualify className)) <> text "." <> text (showIdent ident) <> text ">"
prettyPrintValue d (TypedValue _ val _) = prettyPrintValue d val
prettyPrintValue d (PositionedValue _ _ val) = prettyPrintValue d val
-prettyPrintValue d expr = prettyPrintValueAtom d expr
+prettyPrintValue d expr@NumericLiteral{} = prettyPrintValueAtom d expr
+prettyPrintValue d expr@StringLiteral{} = prettyPrintValueAtom d expr
+prettyPrintValue d expr@CharLiteral{} = prettyPrintValueAtom d expr
+prettyPrintValue d expr@BooleanLiteral{} = prettyPrintValueAtom d expr
+prettyPrintValue d expr@ArrayLiteral{} = prettyPrintValueAtom d expr
+prettyPrintValue d expr@ObjectLiteral{} = prettyPrintValueAtom d expr
+prettyPrintValue d expr@AnonymousArgument{} = prettyPrintValueAtom d expr
+prettyPrintValue d expr@Constructor{} = prettyPrintValueAtom d expr
+prettyPrintValue d expr@Var{} = prettyPrintValueAtom d expr
+prettyPrintValue d expr@OperatorSection{} = prettyPrintValueAtom d expr
+prettyPrintValue d expr@BinaryNoParens{} = prettyPrintValueAtom d expr
+prettyPrintValue d expr@Parens{} = prettyPrintValueAtom d expr
+prettyPrintValue d expr@UnaryMinus{} = prettyPrintValueAtom d expr
+prettyPrintValue d expr@ObjectGetter{} = prettyPrintValueAtom d expr
-- | Pretty-print an atomic expression, adding parentheses if necessary.
prettyPrintValueAtom :: Int -> Expr -> Box
@@ -88,8 +104,16 @@ prettyPrintValueAtom _ (Constructor name) = text $ runProperName (disqualify nam
prettyPrintValueAtom _ (Var ident) = text $ showIdent (disqualify ident)
prettyPrintValueAtom d (OperatorSection op (Right val)) = ((text "(" <> prettyPrintValue (d - 1) op) `beforeWithSpace` prettyPrintValue (d - 1) val) `before` text ")"
prettyPrintValueAtom d (OperatorSection op (Left val)) = ((text "(" <> prettyPrintValue (d - 1) val) `beforeWithSpace` prettyPrintValue (d - 1) op) `before` text ")"
+prettyPrintValueAtom d (BinaryNoParens op lhs rhs) =
+ prettyPrintValue (d - 1) lhs `beforeWithSpace` printOp op `beforeWithSpace` prettyPrintValue (d - 1) rhs
+ where
+ printOp (Var (Qualified _ (Op opName))) = text opName
+ printOp expr = text "`" <> prettyPrintValue (d - 1) expr <> text "`"
prettyPrintValueAtom d (TypedValue _ val _) = prettyPrintValueAtom d val
prettyPrintValueAtom d (PositionedValue _ _ val) = prettyPrintValueAtom d val
+prettyPrintValueAtom d (Parens expr) = (text "(" <> prettyPrintValue d expr) `before` text ")"
+prettyPrintValueAtom d (UnaryMinus expr) = text "(-" <> prettyPrintValue d expr <> text ")"
+prettyPrintValueAtom _ (ObjectGetter field) = text "_." <> text field
prettyPrintValueAtom d expr = (text "(" <> prettyPrintValue d expr) `before` text ")"
prettyPrintDeclaration :: Int -> Declaration -> Box
@@ -143,6 +167,7 @@ prettyPrintBinderAtom (BooleanBinder True) = "true"
prettyPrintBinderAtom (BooleanBinder False) = "false"
prettyPrintBinderAtom (VarBinder ident) = showIdent ident
prettyPrintBinderAtom (ConstructorBinder ctor []) = runProperName (disqualify ctor)
+prettyPrintBinderAtom b@ConstructorBinder{} = parens (prettyPrintBinder b)
prettyPrintBinderAtom (ObjectBinder bs) =
"{ "
++ intercalate ", " (map prettyPrintObjectPropertyBinder bs)
@@ -157,7 +182,10 @@ prettyPrintBinderAtom (ArrayBinder bs) =
prettyPrintBinderAtom (NamedBinder ident binder) = showIdent ident ++ "@" ++ prettyPrintBinder binder
prettyPrintBinderAtom (PositionedBinder _ _ binder) = prettyPrintBinderAtom binder
prettyPrintBinderAtom (TypedBinder _ binder) = prettyPrintBinderAtom binder
-prettyPrintBinderAtom b = parens (prettyPrintBinder b)
+prettyPrintBinderAtom (OpBinder op) = showIdent (disqualify op)
+prettyPrintBinderAtom (BinaryNoParensBinder op b1 b2) =
+ prettyPrintBinderAtom b1 ++ " " ++ prettyPrintBinderAtom op ++ " " ++ prettyPrintBinderAtom b2
+prettyPrintBinderAtom (ParensInBinder b) = parens (prettyPrintBinder b)
-- |
-- Generate a pretty-printed string representing a Binder