summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPhilFreeman <>2014-06-11 19:16:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2014-06-11 19:16:00 (GMT)
commitb612349a679c6b19bf224bd4c7ec363bf59aad3c (patch)
tree7d34c998deaeaf3307b287c44ff74bac9ae9e4fb
parent8e0c34a268d78ca563c22b518fdbf039ed1927e2 (diff)
version 0.5.2.30.5.2.3
-rw-r--r--docgen/Main.hs30
-rw-r--r--prelude/prelude.purs17
-rw-r--r--purescript.cabal2
-rw-r--r--src/Language/PureScript/Pretty/JS.hs2
-rw-r--r--src/Language/PureScript/TypeChecker/Monad.hs2
5 files changed, 40 insertions, 13 deletions
diff --git a/docgen/Main.hs b/docgen/Main.hs
index 8384dfa..a2708be 100644
--- a/docgen/Main.hs
+++ b/docgen/Main.hs
@@ -116,10 +116,12 @@ isExported (Just exps) decl = any (matches decl) exps
isDctorExported :: P.ProperName -> Maybe [P.DeclarationRef] -> P.ProperName -> Bool
isDctorExported _ Nothing _ = True
-isDctorExported ident (Just exps) ctor = flip any exps $ \e -> case e of
- P.TypeRef ident' Nothing -> ident == ident'
- P.TypeRef ident' (Just ctors) -> ident == ident' && ctor `elem` ctors
- _ -> False
+isDctorExported ident (Just exps) ctor = test `any` exps
+ where
+ test (P.PositionedDeclarationRef _ d) = test d
+ test (P.TypeRef ident' Nothing) = ident == ident'
+ test (P.TypeRef ident' (Just ctors)) = ident == ident' && ctor `elem` ctors
+ test _ = False
renderTopLevel :: Maybe [P.DeclarationRef] -> [P.Declaration] -> Docs
renderTopLevel exps decls = forM_ (sortBy (compare `on` getName) decls) $ \decl -> do
@@ -133,20 +135,20 @@ renderTypeclassImage name =
renderDeclaration :: Int -> Maybe [P.DeclarationRef] -> P.Declaration -> Docs
renderDeclaration n _ (P.TypeDeclaration ident ty) =
- atIndent n $ show ident ++ " :: " ++ P.prettyPrintType ty
+ atIndent n $ show ident ++ " :: " ++ prettyPrintType' ty
renderDeclaration n _ (P.ExternDeclaration _ ident _ ty) =
- atIndent n $ show ident ++ " :: " ++ P.prettyPrintType ty
+ atIndent n $ show ident ++ " :: " ++ prettyPrintType' ty
renderDeclaration n exps (P.DataDeclaration name args ctors) = do
- let typeName = P.runProperName name ++ " " ++ unwords args
- atIndent n $ "data " ++ typeName ++ " where"
+ let typeName = P.runProperName name ++ (if null args then "" else " " ++ unwords args)
let exported = filter (isDctorExported name exps . fst) ctors
+ atIndent n $ "data " ++ typeName ++ (if null exported then "" else " where")
forM_ exported $ \(ctor, tys) ->
- atIndent (n + 2) $ P.runProperName ctor ++ " :: " ++ concatMap (\ty -> P.prettyPrintType ty ++ " -> ") tys ++ typeName
+ atIndent (n + 2) $ P.runProperName ctor ++ " :: " ++ concatMap (\ty -> prettyPrintType' ty ++ " -> ") tys ++ typeName
renderDeclaration n _ (P.ExternDataDeclaration name kind) =
atIndent n $ "data " ++ P.runProperName name ++ " :: " ++ P.prettyPrintKind kind
renderDeclaration n _ (P.TypeSynonymDeclaration name args ty) = do
let typeName = P.runProperName name ++ " " ++ unwords args
- atIndent n $ "type " ++ typeName ++ " = " ++ P.prettyPrintType ty
+ atIndent n $ "type " ++ typeName ++ " = " ++ prettyPrintType' ty
renderDeclaration n exps (P.TypeClassDeclaration name args implies ds) = do
let impliesText = case implies of
[] -> ""
@@ -162,6 +164,14 @@ renderDeclaration n exps (P.PositionedDeclaration _ d) =
renderDeclaration n exps d
renderDeclaration _ _ _ = return ()
+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
+
getName :: P.Declaration -> String
getName (P.TypeDeclaration ident _) = show ident
getName (P.ExternDeclaration _ ident _ _) = show ident
diff --git a/prelude/prelude.purs b/prelude/prelude.purs
index 70c7969..3337bb5 100644
--- a/prelude/prelude.purs
+++ b/prelude/prelude.purs
@@ -154,6 +154,20 @@ module Prelude
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 %
@@ -443,6 +457,9 @@ module Prelude
instance semigroupString :: Semigroup String where
(<>) = concatString
+ instance semigroupArr :: (Semigroup s') => Semigroup (s -> s') where
+ (<>) f g = \x -> f x <> g x
+
infixr 5 ++
(++) :: forall s. (Semigroup s) => s -> s -> s
diff --git a/purescript.cabal b/purescript.cabal
index 4605136..e191ece 100644
--- a/purescript.cabal
+++ b/purescript.cabal
@@ -1,5 +1,5 @@
name: purescript
-version: 0.5.2.2
+version: 0.5.2.3
cabal-version: >=1.8
build-type: Custom
license: MIT
diff --git a/src/Language/PureScript/Pretty/JS.hs b/src/Language/PureScript/Pretty/JS.hs
index 3ab0153..ebb42ed 100644
--- a/src/Language/PureScript/Pretty/JS.hs
+++ b/src/Language/PureScript/Pretty/JS.hs
@@ -227,7 +227,6 @@ prettyPrintJS' = A.runKleisli $ runPattern matchValue
++ fromMaybe "" name
++ "(" ++ intercalate ", " args ++ ") "
++ ret ]
- , [ Wrap conditional $ \(th, el) cond -> cond ++ " ? " ++ prettyPrintJS1 th ++ " : " ++ prettyPrintJS1 el ]
, [ binary LessThan "<" ]
, [ binary LessThanOrEqualTo "<=" ]
, [ binary GreaterThan ">" ]
@@ -252,4 +251,5 @@ prettyPrintJS' = A.runKleisli $ runPattern matchValue
, [ binary BitwiseOr "|" ]
, [ binary And "&&" ]
, [ binary Or "||" ]
+ , [ Wrap conditional $ \(th, el) cond -> cond ++ " ? " ++ prettyPrintJS1 th ++ " : " ++ prettyPrintJS1 el ]
]
diff --git a/src/Language/PureScript/TypeChecker/Monad.hs b/src/Language/PureScript/TypeChecker/Monad.hs
index 9caec9e..43b80d4 100644
--- a/src/Language/PureScript/TypeChecker/Monad.hs
+++ b/src/Language/PureScript/TypeChecker/Monad.hs
@@ -136,7 +136,7 @@ data CheckState = CheckState {
-- The type checking monad, which provides the state of the type checker, and error reporting capabilities
--
newtype Check a = Check { unCheck :: StateT CheckState (Either ErrorStack) a }
- deriving (Functor, Monad, Applicative, MonadPlus, MonadState CheckState, MonadError ErrorStack)
+ deriving (Functor, Monad, Applicative, Alternative, MonadPlus, MonadState CheckState, MonadError ErrorStack)
-- |
-- Get the current @Environment@