f6e90c4 · rowtype-yoga/purescript-native

examples/docs/src/TypeOpAliases.pursnew file+18

compare with golang

unifiedsplit

@@ -0,0 +1,18 @@

1+module TypeOpAliases where

2+

3+type AltFn a b = a -> b

4+

5+infixr 6 type AltFn as ~>

6+

7+foreign import test1 :: forall a b. a ~> b

8+foreign import test2 :: forall a b c. a ~> b ~> c

9+foreign import test3 :: forall a b c d. a ~> (b ~> c) ~> d

10+foreign import test4 :: forall a b c d. ((a ~> b) ~> c) ~> d

11+

12+data Tuple a b = Tuple a b

13+

14+infixl 6 Tuple as ×

15+infixl 6 type Tuple as ×

16+

17+third ∷ ∀ a b c. a × b × c → c

18+third (a × b × c) = c

hierarchy/Main.hs+2−1

@@ -30,6 +30,7 @@ import System.FilePath ((</>))

30import System.FilePath.Glob (glob)

31import System.Exit (exitFailure, exitSuccess)

32import System.IO (hPutStr, stderr)

33+import System.IO.UTF8 (readUTF8File)

33

34

34import qualified Language.PureScript as P

35import qualified Language.PureScript as P

35import qualified Paths_purescript as Paths

36import qualified Paths_purescript as Paths

@@ -56,7 +57,7 @@ runModuleName (P.ModuleName pns) = intercalate "_" (P.runProperName `map` pns)

56

57

57readInput :: [FilePath] -> IO (Either P.MultipleErrors [P.Module])

58readInput :: [FilePath] -> IO (Either P.MultipleErrors [P.Module])

58readInput paths = do

59readInput paths = do

59− content <- mapM (\path -> (path, ) <$> readFile path) paths

60+ content <- mapM (\path -> (path, ) <$> readUTF8File path) paths

60 return $ map snd <$> P.parseModulesFromFiles id content

61 return $ map snd <$> P.parseModulesFromFiles id content

61

62

62compile :: HierarchyOptions -> IO ()

63compile :: HierarchyOptions -> IO ()

psc-bundle/Main.hs+2−1

@@ -20,6 +20,7 @@ import System.FilePath (takeFileName, takeDirectory)

20import System.FilePath.Glob (glob)

21import System.Exit (exitFailure)

22import System.IO (stderr, stdout, hPutStrLn, hSetEncoding, utf8)

23+import System.IO.UTF8 (readUTF8File)

23import System.Directory (createDirectoryIfMissing)

24import System.Directory (createDirectoryIfMissing)

24

25

25import Language.PureScript.Bundle

26import Language.PureScript.Bundle

@@ -56,7 +57,7 @@ app Options{..} = do

56 hPutStrLn stderr "psc-bundle: No input files."

57 hPutStrLn stderr "psc-bundle: No input files."

57 exitFailure

58 exitFailure

58 input <- for inputFiles $ \filename -> do

59 input <- for inputFiles $ \filename -> do

59− js <- liftIO (readFile filename)

60+ js <- liftIO (readUTF8File filename)

60 mid <- guessModuleIdentifier filename

61 mid <- guessModuleIdentifier filename

61 length js `seq` return (mid, js) -- evaluate readFile till EOF before returning, not to exhaust file handles

62 length js `seq` return (mid, js) -- evaluate readFile till EOF before returning, not to exhaust file handles

62

63

psc-docs/Main.hs+2−1

@@ -20,6 +20,7 @@ import qualified Language.PureScript as P

20import qualified Paths_purescript as Paths

21import System.Exit (exitFailure)

22import System.IO (hPutStrLn, hPrint, hSetEncoding, stderr, stdout, utf8)

23+import System.IO.UTF8 (readUTF8File)

23import System.Directory (createDirectoryIfMissing)

24import System.Directory (createDirectoryIfMissing)

24import System.FilePath (takeDirectory)

25import System.FilePath (takeDirectory)

25import System.FilePath.Glob (glob)

26import System.FilePath.Glob (glob)

@@ -139,7 +140,7 @@ dumpTags input renderTags = do

139 ldump = mapM_ putStrLn

140 ldump = mapM_ putStrLn

140

141

141parseFile :: FilePath -> IO (FilePath, String)

142parseFile :: FilePath -> IO (FilePath, String)

142−parseFile input = (,) input <$> readFile input

143+parseFile input = (,) input <$> readUTF8File input

143

144

144inputFile :: Parser FilePath

145inputFile :: Parser FilePath

145inputFile = strArgument $

146inputFile = strArgument $

psci/PSCi.hs+4−3

@@ -33,6 +33,7 @@ import System.FilePath ((</>))

33import System.FilePath.Glob (glob)

34import System.Process (readProcessWithExitCode)

35import System.IO.Error (tryIOError)

36+import System.IO.UTF8 (readUTF8File)

36

37

37import qualified Language.PureScript as P

38import qualified Language.PureScript as P

38import qualified Language.PureScript.Names as N

39import qualified Language.PureScript.Names as N

@@ -75,7 +76,7 @@ loop PSCiOptions{..} = do

75 historyFilename <- getHistoryFilename

76 historyFilename <- getHistoryFilename

76 let settings = defaultSettings { historyFile = Just historyFilename }

77 let settings = defaultSettings { historyFile = Just historyFilename }

77 foreignsOrError <- runMake $ do

78 foreignsOrError <- runMake $ do

78− foreignFilesContent <- forM foreignFiles (\inFile -> (inFile,) <$> makeIO (const (P.ErrorMessage [] $ P.CannotReadFile inFile)) (readFile inFile))

79+ foreignFilesContent <- forM foreignFiles (\inFile -> (inFile,) <$> makeIO (const (P.ErrorMessage [] $ P.CannotReadFile inFile)) (readUTF8File inFile))

79 P.parseForeignModulesFromFiles foreignFilesContent

80 P.parseForeignModulesFromFiles foreignFilesContent

80 case foreignsOrError of

81 case foreignsOrError of

81 Left errs -> putStrLn (P.prettyPrintMultipleErrors False errs) >> exitFailure

82 Left errs -> putStrLn (P.prettyPrintMultipleErrors False errs) >> exitFailure

@@ -167,7 +168,7 @@ handleCommand (LoadFile filePath) = PSCI $ whenFileExists filePath $ \absPath ->

167 Right mods -> lift $ modify (updateModules (map (absPath,) mods))

168 Right mods -> lift $ modify (updateModules (map (absPath,) mods))

168handleCommand (LoadForeign filePath) = PSCI $ whenFileExists filePath $ \absPath -> do

169handleCommand (LoadForeign filePath) = PSCI $ whenFileExists filePath $ \absPath -> do

169 foreignsOrError <- lift . lift . runMake $ do

170 foreignsOrError <- lift . lift . runMake $ do

170− foreignFile <- makeIO (const (P.ErrorMessage [] $ P.CannotReadFile absPath)) (readFile absPath)

171+ foreignFile <- makeIO (const (P.ErrorMessage [] $ P.CannotReadFile absPath)) (readUTF8File absPath)

171 P.parseForeignModulesFromFiles [(absPath, foreignFile)]

172 P.parseForeignModulesFromFiles [(absPath, foreignFile)]

172 case foreignsOrError of

173 case foreignsOrError of

173 Left err -> outputStrLn $ P.prettyPrintMultipleErrors False err

174 Left err -> outputStrLn $ P.prettyPrintMultipleErrors False err

@@ -360,7 +361,7 @@ loadUserConfig = onFirstFileMatching readCommands pathGetters

360 exists <- doesFileExist configFile

361 exists <- doesFileExist configFile

361 if exists

362 if exists

362 then do

363 then do

363− ls <- lines <$> readFile configFile

364+ ls <- lines <$> readUTF8File configFile

364 case traverse parseCommand ls of

365 case traverse parseCommand ls of

365 Left err -> print err >> exitFailure

366 Left err -> print err >> exitFailure

366 Right cs -> return $ Just cs

367 Right cs -> return $ Just cs

psci/PSCi/Module.hs+3−2

@@ -6,6 +6,7 @@ import Prelude.Compat

6import qualified Language.PureScript as P

7import PSCi.Types

8import System.FilePath (pathSeparator)

9+import System.IO.UTF8 (readUTF8File)

9import Control.Monad

10import Control.Monad

10

11

11-- | The name of the PSCI support module

12-- | The name of the PSCI support module

@@ -45,7 +46,7 @@ supportModule =

45--

46--

46loadModule :: FilePath -> IO (Either String [P.Module])

47loadModule :: FilePath -> IO (Either String [P.Module])

47loadModule filename = do

48loadModule filename = do

48− content <- readFile filename

49+ content <- readUTF8File filename

49 return $ either (Left . P.prettyPrintMultipleErrors False) (Right . map snd) $ P.parseModulesFromFiles id [(filename, content)]

50 return $ either (Left . P.prettyPrintMultipleErrors False) (Right . map snd) $ P.parseModulesFromFiles id [(filename, content)]

50

51

51-- |

52-- |

@@ -54,7 +55,7 @@ loadModule filename = do

54loadAllModules :: [FilePath] -> IO (Either P.MultipleErrors [(FilePath, P.Module)])

55loadAllModules :: [FilePath] -> IO (Either P.MultipleErrors [(FilePath, P.Module)])

55loadAllModules files = do

56loadAllModules files = do

56 filesAndContent <- forM files $ \filename -> do

57 filesAndContent <- forM files $ \filename -> do

57− content <- readFile filename

58+ content <- readUTF8File filename

58 return (filename, content)

59 return (filename, content)

59 return $ P.parseModulesFromFiles id filesAndContent

60 return $ P.parseModulesFromFiles id filesAndContent

60

61

src/Language/PureScript/Docs/AsMarkdown.hs+1−1

@@ -80,7 +80,7 @@ codeToString :: RenderedCode -> String

80codeToString = outputWith elemAsMarkdown

81 where

82 elemAsMarkdown (Syntax x) = x

83− elemAsMarkdown (Ident x) = x

83+ elemAsMarkdown (Ident x _) = x

84 elemAsMarkdown (Ctor x _) = x

85 elemAsMarkdown (Kind x) = x

86 elemAsMarkdown (Keyword x) = x

src/Language/PureScript/Docs/Convert.hs+2−2

@@ -26,9 +26,9 @@ import Text.Parsec (eof)

26import qualified Language.PureScript as P

27import qualified Language.PureScript.Constants as C

28

29−import Language.PureScript.Docs.Types

30−import Language.PureScript.Docs.Convert.Single (convertSingleModule, collectBookmarks)

31import Language.PureScript.Docs.Convert.ReExports (updateReExports)

29import Language.PureScript.Docs.Convert.ReExports (updateReExports)

30+import Language.PureScript.Docs.Convert.Single (convertSingleModule, collectBookmarks)

31+import Language.PureScript.Docs.Types

32

33-- |

34-- Like convertModules, except that it takes a list of modules, together with

src/Language/PureScript/Docs/Convert/ReExports.hs+23−2

@@ -111,13 +111,14 @@ collectDeclarations imports exports = do

111 valsAndMembers <- collect lookupValueDeclaration impVals expVals

112 typeClasses <- collect lookupTypeClassDeclaration impTCs expTCs

113 types <- collect lookupTypeDeclaration impTypes expTypes

114+ typeOps <- collect lookupTypeOpDeclaration impTypeOps expTypeOps

114

115

115 (vals, classes) <- handleTypeClassMembers valsAndMembers typeClasses

116 (vals, classes) <- handleTypeClassMembers valsAndMembers typeClasses

116

117

117 let filteredTypes = filterDataConstructors expCtors types

118 let filteredTypes = filterDataConstructors expCtors types

118 let filteredClasses = filterTypeClassMembers (map fst expVals) classes

119 let filteredClasses = filterTypeClassMembers (map fst expVals) classes

119

120

120− pure (Map.toList (Map.unionsWith (<>) [filteredTypes, filteredClasses, vals]))

121+ pure (Map.toList (Map.unionsWith (<>) [filteredTypes, typeOps, filteredClasses, vals]))

121

122

122 where

123 where

123 collect lookup' imps exps = do

124 collect lookup' imps exps = do

@@ -130,6 +131,9 @@ collectDeclarations imports exports = do

130 expTypes = map (first fst) (P.exportedTypes exports)

131 expTypes = map (first fst) (P.exportedTypes exports)

131 impTypes = concat (Map.elems (P.importedTypes imports))

132 impTypes = concat (Map.elems (P.importedTypes imports))

132

133

134+ expTypeOps = P.exportedTypeOps exports

135+ impTypeOps = concat (Map.elems (P.importedTypeOps imports))

136+

133 expCtors = concatMap (snd . fst) (P.exportedTypes exports)

137 expCtors = concatMap (snd . fst) (P.exportedTypes exports)

134

138

135 expTCs = P.exportedTypeClasses exports

139 expTCs = P.exportedTypeClasses exports

@@ -180,7 +184,7 @@ lookupValueDeclaration importedFrom ident = do

180 let

184 let

181 rs =

185 rs =

182 filter (\d -> declTitle d == P.showIdent ident

186 filter (\d -> declTitle d == P.showIdent ident

183− && (isValue d || isAlias d)) decls

187+ && (isValue d || isValueAlias d)) decls

184 errOther other =

188 errOther other =

185 internalErrorInModule

189 internalErrorInModule

186 ("lookupValueDeclaration: unexpected result:\n" ++

190 ("lookupValueDeclaration: unexpected result:\n" ++

@@ -243,6 +247,23 @@ lookupTypeDeclaration importedFrom ty = do

243 internalErrorInModule

247 internalErrorInModule

244 ("lookupTypeDeclaration: unexpected result: " ++ show other)

248 ("lookupTypeDeclaration: unexpected result: " ++ show other)

245

249

250+lookupTypeOpDeclaration ::

251+ (MonadState (Map P.ModuleName Module) m,

252+ MonadReader P.ModuleName m) =>

253+ P.ModuleName ->

254+ P.Ident ->

255+ m (P.ModuleName, [Declaration])

256+lookupTypeOpDeclaration importedFrom tyOp = do

257+ decls <- lookupModuleDeclarations "lookupTypeOpDeclaration" importedFrom

258+ let

259+ ds = filter (\d -> declTitle d == ("type " ++ P.showIdent tyOp) && isTypeAlias d) decls

260+ case ds of

261+ [d] ->

262+ pure (importedFrom, [d])

263+ other ->

264+ internalErrorInModule

265+ ("lookupTypeOpDeclaration: unexpected result: " ++ show other)

266+

246lookupTypeClassDeclaration ::

267lookupTypeClassDeclaration ::

247 (MonadState (Map P.ModuleName Module) m,

268 (MonadState (Map P.ModuleName Module) m,

248 MonadReader P.ModuleName m) =>

269 MonadReader P.ModuleName m) =>

src/Language/PureScript/Docs/Convert/Single.hs+10−9

@@ -108,16 +108,17 @@ addDefaultFixity decl@Declaration{..}

108 defaultFixity = P.Fixity P.Infixl (-1)

109

110getDeclarationTitle :: P.Declaration -> Maybe String

111−getDeclarationTitle (P.ValueDeclaration name _ _ _) = Just (P.showIdent name)

111+getDeclarationTitle (P.ValueDeclaration name _ _ _) = Just (P.showIdent name)

112−getDeclarationTitle (P.ExternDeclaration name _) = Just (P.showIdent name)

112+getDeclarationTitle (P.ExternDeclaration name _) = Just (P.showIdent name)

113−getDeclarationTitle (P.DataDeclaration _ name _ _) = Just (P.runProperName name)

113+getDeclarationTitle (P.DataDeclaration _ name _ _) = Just (P.runProperName name)

114−getDeclarationTitle (P.ExternDataDeclaration name _) = Just (P.runProperName name)

114+getDeclarationTitle (P.ExternDataDeclaration name _) = Just (P.runProperName name)

115−getDeclarationTitle (P.TypeSynonymDeclaration name _ _) = Just (P.runProperName name)

115+getDeclarationTitle (P.TypeSynonymDeclaration name _ _) = Just (P.runProperName name)

116−getDeclarationTitle (P.TypeClassDeclaration name _ _ _) = Just (P.runProperName name)

116+getDeclarationTitle (P.TypeClassDeclaration name _ _ _) = Just (P.runProperName name)

117getDeclarationTitle (P.TypeInstanceDeclaration name _ _ _ _) = Just (P.showIdent name)

118−getDeclarationTitle (P.FixityDeclaration _ name _) = Just ("(" ++ name ++ ")")

118+getDeclarationTitle (P.FixityDeclaration _ name (Just (P.Qualified _ P.AliasType{}))) = Just ("type (" ++ name ++ ")")

119+getDeclarationTitle (P.FixityDeclaration _ name _) = Just ("(" ++ name ++ ")")

119−getDeclarationTitle (P.PositionedDeclaration _ _ d) = getDeclarationTitle d

120+getDeclarationTitle (P.PositionedDeclaration _ _ d) = getDeclarationTitle d

120−getDeclarationTitle _ = Nothing

121+getDeclarationTitle _ = Nothing

121

122

122-- | Create a basic Declaration value.

123-- | Create a basic Declaration value.

123mkDeclaration :: String -> DeclarationInfo -> Declaration

124mkDeclaration :: String -> DeclarationInfo -> Declaration

src/Language/PureScript/Docs/ParseAndBookmark.hs+3−1

@@ -16,6 +16,8 @@ import Control.Monad.IO.Class (MonadIO(..))

16

17import Web.Bower.PackageMeta (PackageName)

18

19+import System.IO.UTF8 (readUTF8File)

20+

19import qualified Language.PureScript as P

21import qualified Language.PureScript as P

20import Language.PureScript.Docs.Types

22import Language.PureScript.Docs.Types

21import Language.PureScript.Docs.Convert (collectBookmarks)

23import Language.PureScript.Docs.Convert (collectBookmarks)

@@ -80,7 +82,7 @@ fileInfoToString (Local fn) = fn

80fileInfoToString (FromDep _ fn) = fn

82fileInfoToString (FromDep _ fn) = fn

81

83

82parseFile :: FilePath -> IO (FilePath, String)

84parseFile :: FilePath -> IO (FilePath, String)

83−parseFile input' = (,) input' <$> readFile input'

85+parseFile input' = (,) input' <$> readUTF8File input'

84

86

85parseAs :: (MonadIO m) => (FilePath -> a) -> FilePath -> m (a, String)

87parseAs :: (MonadIO m) => (FilePath -> a) -> FilePath -> m (a, String)

86parseAs g = fmap (first g) . liftIO . parseFile

88parseAs g = fmap (first g) . liftIO . parseFile

src/Language/PureScript/Docs/Render.hs+7−4

@@ -58,26 +58,29 @@ renderDeclarationWithOptions opts Declaration{..} =

58 syntax "("

59 <> mintersperse (syntax "," <> sp) (map renderConstraint implies)

60 <> syntax ")" <> sp <> syntax "<="

61− AliasDeclaration for (P.Fixity associativity precedence) ->

61+ AliasDeclaration for@(P.Qualified _ alias) (P.Fixity associativity precedence) ->

62 [ keywordFixity associativity

63 , syntax $ show precedence

64 , ident $ renderAlias for

65 , keyword "as"

66− , ident . tail . init $ declTitle

66+ , ident $ adjustAliasName alias declTitle

67 ]

68

69 where

70 renderType' = renderTypeWithOptions opts

71 renderAlias (P.Qualified mn alias)

72 | mn == currentModule opts =

73− P.foldFixityAlias P.runIdent P.runProperName P.runProperName alias

73+ P.foldFixityAlias P.runIdent P.runProperName (("type " ++) . P.runProperName) alias

74 | otherwise =

75 P.foldFixityAlias

76 (P.showQualified P.runIdent . P.Qualified mn)

77 (P.showQualified P.runProperName . P.Qualified mn)

78− (P.showQualified P.runProperName . P.Qualified mn)

78+ (("type " ++) . P.showQualified P.runProperName . P.Qualified mn)

79 alias

80

81+ adjustAliasName (P.AliasType{}) title = drop 6 (init title)

82+ adjustAliasName _ title = tail (init title)

83+

81renderChildDeclaration :: ChildDeclaration -> RenderedCode

84renderChildDeclaration :: ChildDeclaration -> RenderedCode

82renderChildDeclaration = renderChildDeclarationWithOptions defaultRenderTypeOptions

85renderChildDeclaration = renderChildDeclarationWithOptions defaultRenderTypeOptions

83

86

src/Language/PureScript/Docs/RenderedCode/Render.hs+12−1

@@ -48,6 +48,10 @@ typeLiterals = mkPattern match

48 Just (syntax "()")

49 match row@RCons{} =

50 Just (syntax "(" <> renderRow row <> syntax ")")

51+ match (BinaryNoParensType op l r) =

52+ Just $ renderTypeAtom l <> sp <> renderTypeAtom op <> sp <> renderTypeAtom r

53+ match (TypeOp (Qualified mn op)) =

54+ Just (ident' (runIdent op) (maybeToContainingModule mn))

51 match _ =

55 match _ =

52 Nothing

56 Nothing

53

57

@@ -115,6 +119,12 @@ constrained = mkPattern match

115 match (ConstrainedType deps ty) = Just (deps, ty)

119 match (ConstrainedType deps ty) = Just (deps, ty)

116 match _ = Nothing

120 match _ = Nothing

117

121

122+explicitParens :: Pattern () Type ((), Type)

123+explicitParens = mkPattern match

124+ where

125+ match (ParensInType ty) = Just ((), ty)

126+ match _ = Nothing

127+

118matchTypeAtom :: Pattern () Type RenderedCode

128matchTypeAtom :: Pattern () Type RenderedCode

119matchTypeAtom = typeLiterals <+> fmap parens matchType

129matchTypeAtom = typeLiterals <+> fmap parens matchType

120 where

130 where

@@ -130,6 +140,7 @@ matchType = buildPrettyPrinter operators matchTypeAtom

130 , [ Wrap constrained $ \deps ty -> renderConstraints deps ty ]

140 , [ Wrap constrained $ \deps ty -> renderConstraints deps ty ]

131 , [ Wrap forall_ $ \idents ty -> mconcat [syntax "forall", sp, mintersperse sp (map ident idents), syntax ".", sp, ty] ]

141 , [ Wrap forall_ $ \idents ty -> mconcat [syntax "forall", sp, mintersperse sp (map ident idents), syntax ".", sp, ty] ]

132 , [ Wrap kinded $ \k ty -> mintersperse sp [ty, syntax "::", renderKind k] ]

142 , [ Wrap kinded $ \k ty -> mintersperse sp [ty, syntax "::", renderKind k] ]

143+ , [ Wrap explicitParens $ \_ ty -> ty ]

133 ]

144 ]

134

145

135forall_ :: Pattern () Type ([String], Type)

146forall_ :: Pattern () Type ([String], Type)

@@ -156,7 +167,7 @@ convert _ other = other

156convertForAlls :: Type -> Type

167convertForAlls :: Type -> Type

157convertForAlls (ForAll i ty _) = go [i] ty

168convertForAlls (ForAll i ty _) = go [i] ty

158 where

169 where

159− go idents (ForAll ident' ty' _) = go (ident' : idents) ty'

170+ go idents (ForAll i' ty' _) = go (i' : idents) ty'

160 go idents other = PrettyPrintForAll idents other

171 go idents other = PrettyPrintForAll idents other

161convertForAlls other = other

172convertForAlls other = other

162

173

src/Language/PureScript/Docs/RenderedCode/Types.hs+10−5

@@ -18,6 +18,7 @@ module Language.PureScript.Docs.RenderedCode.Types

18 , sp

19 , syntax

20 , ident

21+ , ident'

21 , ctor

22 , ctor

22 , kind

23 , kind

23 , keyword

24 , keyword

@@ -46,7 +47,7 @@ import qualified Language.PureScript as P

46--

47--

47data RenderedCodeElement

48data RenderedCodeElement

48 = Syntax String

49 = Syntax String

49− | Ident String

50+ | Ident String ContainingModule

50 | Ctor String ContainingModule

51 | Ctor String ContainingModule

51 | Kind String

52 | Kind String

52 | Keyword String

53 | Keyword String

@@ -56,8 +57,8 @@ data RenderedCodeElement

56instance A.ToJSON RenderedCodeElement where

57instance A.ToJSON RenderedCodeElement where

57 toJSON (Syntax str) =

58 toJSON (Syntax str) =

58 A.toJSON ["syntax", str]

59 A.toJSON ["syntax", str]

59− toJSON (Ident str) =

60+ toJSON (Ident str mn) =

60− A.toJSON ["ident", str]

61+ A.toJSON ["ident", A.toJSON str, A.toJSON mn]

61 toJSON (Ctor str mn) =

62 toJSON (Ctor str mn) =

62 A.toJSON ["ctor", A.toJSON str, A.toJSON mn ]

63 A.toJSON ["ctor", A.toJSON str, A.toJSON mn ]

63 toJSON (Kind str) =

64 toJSON (Kind str) =

@@ -70,7 +71,7 @@ instance A.ToJSON RenderedCodeElement where

70asRenderedCodeElement :: Parse String RenderedCodeElement

71asRenderedCodeElement :: Parse String RenderedCodeElement

71asRenderedCodeElement =

72asRenderedCodeElement =

72 a Syntax "syntax" <|>

73 a Syntax "syntax" <|>

73− a Ident "ident" <|>

74+ asIdent <|>

74 asCtor <|>

75 asCtor <|>

75 a Kind "kind" <|>

76 a Kind "kind" <|>

76 a Keyword "keyword" <|>

77 a Keyword "keyword" <|>

@@ -80,6 +81,7 @@ asRenderedCodeElement =

80 p <|> q = catchError p (const q)

81 p <|> q = catchError p (const q)

81

82

82 a ctor' ctorStr = ctor' <$> (nth 0 (withString (eq ctorStr)) *> nth 1 asString)

83 a ctor' ctorStr = ctor' <$> (nth 0 (withString (eq ctorStr)) *> nth 1 asString)

84+ asIdent = nth 0 (withString (eq "ident")) *> (Ident <$> nth 1 asString <*> nth 2 asContainingModule)

83 asCtor = nth 0 (withString (eq "ctor")) *> (Ctor <$> nth 1 asString <*> nth 2 asContainingModule)

85 asCtor = nth 0 (withString (eq "ctor")) *> (Ctor <$> nth 1 asString <*> nth 2 asContainingModule)

84 asSpace = nth 0 (withString (eq "space")) *> pure Space

86 asSpace = nth 0 (withString (eq "space")) *> pure Space

85

87

@@ -159,7 +161,10 @@ syntax :: String -> RenderedCode

159syntax x = RC [Syntax x]

161syntax x = RC [Syntax x]

160

162

161ident :: String -> RenderedCode

163ident :: String -> RenderedCode

162−ident x = RC [Ident x]

164+ident x = RC [Ident x ThisModule]

165+

166+ident' :: String -> ContainingModule -> RenderedCode

167+ident' x m = RC [Ident x m]

163

168

164ctor :: String -> ContainingModule -> RenderedCode

169ctor :: String -> ContainingModule -> RenderedCode

165ctor x m = RC [Ctor x m]

170ctor x m = RC [Ctor x m]

src/Language/PureScript/Docs/Types.hs+10−3

@@ -164,10 +164,17 @@ isType Declaration{..} =

164 ExternDataDeclaration{} -> True

165 _ -> False

166

167−isAlias :: Declaration -> Bool

167+isValueAlias :: Declaration -> Bool

168−isAlias Declaration{..} =

168+isValueAlias Declaration{..} =

169 case declInfo of

170− AliasDeclaration{} -> True

170+ (AliasDeclaration (P.Qualified _ P.AliasConstructor{}) _) -> True

171+ (AliasDeclaration (P.Qualified _ P.AliasValue{}) _) -> True

172+ _ -> False

173+

174+isTypeAlias :: Declaration -> Bool

175+isTypeAlias Declaration{..} =

176+ case declInfo of

177+ (AliasDeclaration (P.Qualified _ P.AliasType{}) _) -> True

171 _ -> False

178 _ -> False

172

179

173-- | Discard any children which do not satisfy the given predicate.

180-- | Discard any children which do not satisfy the given predicate.

src/Language/PureScript/Ide/SourceFile.hs+2−1

@@ -35,6 +35,7 @@ import Language.PureScript.Ide.Types

35import qualified Language.PureScript.Names as N

36import qualified Language.PureScript.Parser as P

37import System.Directory

38+import System.IO.UTF8 (readUTF8File)

38

39

39parseModuleFromFile :: (MonadIO m, MonadError PscIdeError m) =>

40parseModuleFromFile :: (MonadIO m, MonadError PscIdeError m) =>

40 FilePath -> m D.Module

41 FilePath -> m D.Module

@@ -42,7 +43,7 @@ parseModuleFromFile fp = do

42 exists <- liftIO (doesFileExist fp)

43 exists <- liftIO (doesFileExist fp)

43 if exists

44 if exists

44 then do

45 then do

45− content <- liftIO (readFile fp)

46+ content <- liftIO (readUTF8File fp)

46 let m = do tokens <- P.lex fp content

47 let m = do tokens <- P.lex fp content

47 P.runTokenParser "" P.parseModule tokens

48 P.runTokenParser "" P.parseModule tokens

48 either (throwError . (`ParseError` "File could not be parsed.")) pure m

49 either (throwError . (`ParseError` "File could not be parsed.")) pure m

src/Language/PureScript/Pretty/Types.hs+10

@@ -36,6 +36,9 @@ typeLiterals = mkPattern match

36 match (Skolem name s _ _) = Just $ text $ name ++ show s

37 match REmpty = Just $ text "()"

38 match row@RCons{} = Just $ prettyPrintRowWith '(' ')' row

39+ match (BinaryNoParensType op l r) =

40+ Just $ typeAsBox l <> text " " <> typeAsBox op <> text " " <> typeAsBox r

41+ match (TypeOp op) = Just $ text $ showQualified runIdent op

39 match _ = Nothing

42 match _ = Nothing

40

43

41constraintsAsBox :: [Constraint] -> Box -> Box

44constraintsAsBox :: [Constraint] -> Box -> Box

@@ -108,6 +111,12 @@ constrained = mkPattern match

108 match (ConstrainedType deps ty) = Just (deps, ty)

111 match (ConstrainedType deps ty) = Just (deps, ty)

109 match _ = Nothing

112 match _ = Nothing

110

113

114+explicitParens :: Pattern () Type ((), Type)

115+explicitParens = mkPattern match

116+ where

117+ match (ParensInType ty) = Just ((), ty)

118+ match _ = Nothing

119+

111matchTypeAtom :: Pattern () Type Box

120matchTypeAtom :: Pattern () Type Box

112matchTypeAtom = typeLiterals <+> fmap ((`before` (text ")")) . (text "(" <>)) matchType

121matchTypeAtom = typeLiterals <+> fmap ((`before` (text ")")) . (text "(" <>)) matchType

113

122

@@ -121,6 +130,7 @@ matchType = buildPrettyPrinter operators matchTypeAtom

121 , [ Wrap constrained $ \deps ty -> constraintsAsBox deps ty ]

130 , [ Wrap constrained $ \deps ty -> constraintsAsBox deps ty ]

122 , [ Wrap forall_ $ \idents ty -> keepSingleLinesOr (moveRight 2) (text ("forall " ++ unwords idents ++ ".")) ty ]

131 , [ Wrap forall_ $ \idents ty -> keepSingleLinesOr (moveRight 2) (text ("forall " ++ unwords idents ++ ".")) ty ]

123 , [ Wrap kinded $ \k ty -> keepSingleLinesOr (moveRight 2) ty (text (":: " ++ prettyPrintKind k)) ]

132 , [ Wrap kinded $ \k ty -> keepSingleLinesOr (moveRight 2) ty (text (":: " ++ prettyPrintKind k)) ]

133+ , [ Wrap explicitParens $ \_ ty -> ty ]

124 ]

134 ]

125

135

126 -- If both boxes span a single line, keep them on the same line, or else

136 -- If both boxes span a single line, keep them on the same line, or else

src/Language/PureScript/Sugar/Operators.hs+1−1

@@ -55,7 +55,7 @@ type FixityRecord = (Qualified Ident, SourceSpan, Fixity, Maybe (Qualified Fixit

55--

56rebracket

57 :: forall m

58− . (MonadError MultipleErrors m)

58+ . MonadError MultipleErrors m

59 => [ExternsFile]

60 -> [Module]

61 -> m [Module]

tests/Main.hs−13

@@ -1,16 +1,3 @@

1−-----------------------------------------------------------------------------

2−--

3−-- Module : Main

4−-- License : MIT (http://opensource.org/licenses/MIT)

5−--

6−-- Maintainer : Phil Freeman <paf31@cantab.net>

7−-- Stability : experimental

8−-- Portability :

9−--

10−-- |

11−--

12−-----------------------------------------------------------------------------

13−

14{-# LANGUAGE DataKinds #-}

1{-# LANGUAGE DataKinds #-}

15{-# LANGUAGE DoAndIfThenElse #-}

2{-# LANGUAGE DoAndIfThenElse #-}

16{-# LANGUAGE TupleSections #-}

3{-# LANGUAGE TupleSections #-}

tests/TestDocs.hs+17−6

@@ -285,12 +285,20 @@ testCases =

285 , ValueShouldHaveTypeSignature (n "ExplicitTypeSignatures") "aNumber" (ShowFn (P.tyNumber ==))

286 ])

287

288− --, ("ConstrainedArgument",

288+ , ("ConstrainedArgument",

289− -- [ TypeSynonymShouldRenderAs (n "ConstrainedArgument") "WithoutArgs" "forall a. (Partial => a) -> a"

289+ [ TypeSynonymShouldRenderAs (n "ConstrainedArgument") "WithoutArgs" "forall a. (Partial => a) -> a"

290− -- , TypeSynonymShouldRenderAs (n "ConstrainedArgument") "WithArgs" "forall a. (Foo a => a) -> a"

290+ , TypeSynonymShouldRenderAs (n "ConstrainedArgument") "WithArgs" "forall a. (Foo a => a) -> a"

291− -- , TypeSynonymShouldRenderAs (n "ConstrainedArgument") "MultiWithoutArgs" "forall a. ((Partial, Partial) => a) -> a"

291+ , TypeSynonymShouldRenderAs (n "ConstrainedArgument") "MultiWithoutArgs" "forall a. ((Partial, Partial) => a) -> a"

292− -- , TypeSynonymShouldRenderAs (n "ConstrainedArgument") "MultiWithArgs" "forall a b. ((Foo a, Foo b) => a) -> a"

292+ , TypeSynonymShouldRenderAs (n "ConstrainedArgument") "MultiWithArgs" "forall a b. ((Foo a, Foo b) => a) -> a"

293+ ])

294+

295+ , ("TypeOpAliases",

296+ [ ValueShouldHaveTypeSignature (n "TypeOpAliases") "test1" (renderedType "forall a b. a ~> b")

297+ , ValueShouldHaveTypeSignature (n "TypeOpAliases") "test2" (renderedType "forall a b c. a ~> b ~> c")

298+ , ValueShouldHaveTypeSignature (n "TypeOpAliases") "test3" (renderedType "forall a b c d. a ~> (b ~> c) ~> d")

299+ , ValueShouldHaveTypeSignature (n "TypeOpAliases") "test4" (renderedType "forall a b c d. ((a ~> b) ~> c) ~> d")

300+ , ValueShouldHaveTypeSignature (n "TypeOpAliases") "third" (renderedType "forall a b c. a × b × c -> c")

293− -- ])

301+ ])

294 ]

302 ]

295

303

296 where

304 where

@@ -301,3 +309,6 @@ testCases =

301

309

302 isVar varName (P.TypeVar name) | varName == name = True

310 isVar varName (P.TypeVar name) | varName == name = True

303 isVar _ _ = False

311 isVar _ _ = False

312+

313+ renderedType expected =

314+ ShowFn $ \ty -> codeToString (Docs.renderType ty) == expected

tests/TestPsci.hs+2−1

@@ -17,6 +17,7 @@ import System.Exit (exitFailure)

17import System.Console.Haskeline

18import System.FilePath ((</>))

19import System.Directory (getCurrentDirectory)

20+import System.IO.UTF8 (readUTF8File)

20import qualified System.FilePath.Glob as Glob

21import qualified System.FilePath.Glob as Glob

21

22

22import Test.HUnit

23import Test.HUnit

@@ -132,7 +133,7 @@ getPSCiState = do

132 jsFiles <- supportFiles "js"

133 jsFiles <- supportFiles "js"

133

134

134 modulesOrFirstError <- loadAllModules pursFiles

135 modulesOrFirstError <- loadAllModules pursFiles

135− foreignFiles <- forM jsFiles (\f -> (f,) <$> readFile f)

136+ foreignFiles <- forM jsFiles (\f -> (f,) <$> readUTF8File f)

136 Right (foreigns, _) <- runExceptT $ runWriterT $ P.parseForeignModulesFromFiles foreignFiles

137 Right (foreigns, _) <- runExceptT $ runWriterT $ P.parseForeignModulesFromFiles foreignFiles

137 case modulesOrFirstError of

138 case modulesOrFirstError of

138 Left err ->

139 Left err ->