0a92e7f · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

Always read UTF-8, tests

commit0a92e7ff913f865c42c4e6ab67cfd39c12ac3257 authorGary Burgess <gary.burgess@gmail.com> dateSun 17 Apr 2016, 14:37 (11 years ago) parent8051524

14 files changed+103−33

compare with golang

unifiedsplit

examples/docs/src/TypeOpAliases.purs+18 hierarchy/Main.hs+2−1 psc-bundle/Main.hs+2−1 psc-docs/Main.hs+2−1 psci/PSCi.hs+4−3 psci/PSCi/Module.hs+3−2 src/Language/PureScript/Docs/Convert/ReExports.hs+23−2 src/Language/PureScript/Docs/Convert/Single.hs+10−9 src/Language/PureScript/Docs/ParseAndBookmark.hs+3−1 src/Language/PureScript/Docs/Render.hs+5−2 src/Language/PureScript/Docs/Types.hs+10−3 src/Language/PureScript/Ide/SourceFile.hs+2−1 tests/TestDocs.hs+17−6 tests/TestPsci.hs+2−1

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

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

1+module TypeOpAliases where

3+type AltFn a b = a -> b

5+infixr 6 type AltFn as ~>

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 ((</>))

3030import System.FilePath.Glob (glob)

3131import System.Exit (exitFailure, exitSuccess)

3232import System.IO (hPutStr, stderr)

33+import System.IO.UTF8 (readUTF8File)

3334

3435import qualified Language.PureScript as P

3536import qualified Paths_purescript as Paths

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

5657

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

5859readInput paths = do

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

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

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

6162

6263compile :: HierarchyOptions -> IO ()

psc-bundle/Main.hs+2−1

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

2020import System.FilePath.Glob (glob)

2121import System.Exit (exitFailure)

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

23+import System.IO.UTF8 (readUTF8File)

2324import System.Directory (createDirectoryIfMissing)

2425

2526import Language.PureScript.Bundle

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

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

5758 exitFailure

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

59− js <- liftIO (readFile filename)

60+ js <- liftIO (readUTF8File filename)

6061 mid <- guessModuleIdentifier filename

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

6263

psc-docs/Main.hs+2−1

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

2020import qualified Paths_purescript as Paths

2121import System.Exit (exitFailure)

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

23+import System.IO.UTF8 (readUTF8File)

2324import System.Directory (createDirectoryIfMissing)

2425import System.FilePath (takeDirectory)

2526import System.FilePath.Glob (glob)

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

139140 ldump = mapM_ putStrLn

140141

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

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

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

143144

144145inputFile :: Parser FilePath

145146inputFile = strArgument $

psci/PSCi.hs+4−3

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

3333import System.FilePath.Glob (glob)

3434import System.Process (readProcessWithExitCode)

3535import System.IO.Error (tryIOError)

36+import System.IO.UTF8 (readUTF8File)

3637

3738import qualified Language.PureScript as P

3839import qualified Language.PureScript.Names as N

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

7576 historyFilename <- getHistoryFilename

7677 let settings = defaultSettings { historyFile = Just historyFilename }

7778 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))

7980 P.parseForeignModulesFromFiles foreignFilesContent

8081 case foreignsOrError of

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

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

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

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

169170 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)

171172 P.parseForeignModulesFromFiles [(absPath, foreignFile)]

172173 case foreignsOrError of

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

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

360361 exists <- doesFileExist configFile

361362 if exists

362363 then do

363− ls <- lines <$> readFile configFile

364+ ls <- lines <$> readUTF8File configFile

364365 case traverse parseCommand ls of

365366 Left err -> print err >> exitFailure

366367 Right cs -> return $ Just cs

psci/PSCi/Module.hs+3−2

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

66import qualified Language.PureScript as P

77import PSCi.Types

88import System.FilePath (pathSeparator)

9+import System.IO.UTF8 (readUTF8File)

910import Control.Monad

1011

1112-- | The name of the PSCI support module

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

4546--

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

4748loadModule filename = do

48− content <- readFile filename

49+ content <- readUTF8File filename

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

5051

5152-- |

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

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

5556loadAllModules files = do

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

57− content <- readFile filename

58+ content <- readUTF8File filename

5859 return (filename, content)

5960 return $ P.parseModulesFromFiles id filesAndContent

6061

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

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

111111 valsAndMembers <- collect lookupValueDeclaration impVals expVals

112112 typeClasses <- collect lookupTypeClassDeclaration impTCs expTCs

113113 types <- collect lookupTypeDeclaration impTypes expTypes

114+ typeOps <- collect lookupTypeOpDeclaration impTypeOps expTypeOps

114115

115116 (vals, classes) <- handleTypeClassMembers valsAndMembers typeClasses

116117

117118 let filteredTypes = filterDataConstructors expCtors types

118119 let filteredClasses = filterTypeClassMembers (map fst expVals) classes

119120

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

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

121122

122123 where

123124 collect lookup' imps exps = do

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

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

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

132133

134+ expTypeOps = P.exportedTypeOps exports

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

136+

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

134138

135139 expTCs = P.exportedTypeClasses exports

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

180184 let

181185 rs =

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

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

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

184188 errOther other =

185189 internalErrorInModule

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

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

243247 internalErrorInModule

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

245249

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+

246267lookupTypeClassDeclaration ::

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

248269 MonadReader P.ModuleName m) =>

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

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

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

109109

110110getDeclarationTitle :: P.Declaration -> Maybe String

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

120−getDeclarationTitle _ = Nothing

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

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

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

121+getDeclarationTitle _ = Nothing

121122

122123-- | Create a basic Declaration value.

123124mkDeclaration :: String -> DeclarationInfo -> Declaration

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

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

1616

1717import Web.Bower.PackageMeta (PackageName)

1818

19+import System.IO.UTF8 (readUTF8File)

20+

1921import qualified Language.PureScript as P

2022import Language.PureScript.Docs.Types

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

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

8082fileInfoToString (FromDep _ fn) = fn

8183

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

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

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

8486

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

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

src/Language/PureScript/Docs/Render.hs+5−2

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

5858 syntax "("

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

6060 <> syntax ")" <> sp <> syntax "<="

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

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

6262 [ keywordFixity associativity

6363 , syntax $ show precedence

6464 , ident $ renderAlias for

6565 , keyword "as"

66− , ident . tail . init $ declTitle

66+ , ident $ adjustAliasName alias declTitle

6767 ]

6868

6969 where

@@ -78,6 +78,9 @@ renderDeclarationWithOptions opts Declaration{..} =

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

7979 alias

8080

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

82+ adjustAliasName _ title = tail (init title)

83+

8184renderChildDeclaration :: ChildDeclaration -> RenderedCode

8285renderChildDeclaration = renderChildDeclarationWithOptions defaultRenderTypeOptions

8386

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

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

164164 ExternDataDeclaration{} -> True

165165 _ -> False

166166

167−isAlias :: Declaration -> Bool

168−isAlias Declaration{..} =

167+isValueAlias :: Declaration -> Bool

168+isValueAlias Declaration{..} =

169169 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

171178 _ -> False

172179

173180-- | 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

3535import qualified Language.PureScript.Names as N

3636import qualified Language.PureScript.Parser as P

3737import System.Directory

38+import System.IO.UTF8 (readUTF8File)

3839

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

4041 FilePath -> m D.Module

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

4243 exists <- liftIO (doesFileExist fp)

4344 if exists

4445 then do

45− content <- liftIO (readFile fp)

46+ content <- liftIO (readUTF8File fp)

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

4748 P.runTokenParser "" P.parseModule tokens

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

tests/TestDocs.hs+17−6

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

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

286286 ])

287287

288− , ("ConstrainedArgument",

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

290− , TypeSynonymShouldRenderAs (n "ConstrainedArgument") "WithArgs" "forall a. (Foo a => 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"

293− ])

288+ , ("ConstrainedArgument",

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

290+ , TypeSynonymShouldRenderAs (n "ConstrainedArgument") "WithArgs" "forall a. (Foo a => 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"

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")

301+ ])

294302 ]

295303

296304 where

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

301309

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

303311 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)

1717import System.Console.Haskeline

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

1919import System.Directory (getCurrentDirectory)

20+import System.IO.UTF8 (readUTF8File)

2021import qualified System.FilePath.Glob as Glob

2122

2223import Test.HUnit

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

132133 jsFiles <- supportFiles "js"

133134

134135 modulesOrFirstError <- loadAllModules pursFiles

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

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

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

137138 case modulesOrFirstError of

138139 Left err ->