34f0cd8 · rowtype-yoga/purescript-native

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

Parse module name with dots

commit34f0cd8dcb9c2fa55ec0385fa234c89f39a697b2 authorGary Burgess <gary.burgess@gmail.com> dateMon 17 Feb 2014, 21:58 (13 years ago) parentd3f368b

6 files changed+41−16

compare with golang

unifiedsplit

examples/passing/DottedModules.purs+16 src/Language/PureScript/CodeGen/Common.hs+3 src/Language/PureScript/CodeGen/JS.hs+4−7 src/Language/PureScript/Parser/Common.hs+13−4 src/Language/PureScript/Parser/Declarations.hs+3−3 src/Language/PureScript/Sugar/TypeClasses.hs+2−2

examples/passing/DottedModules.pursnew file+16

@@ -0,0 +1,16 @@

1+module Some.Module.Name where

3+ class Foo a where

4+ foo :: a -> a

6+ x = "Done"

8+module Main where

10+ import Prelude

11+ import Some.Module.Name

12+

13+ instance Some.Module.Name.Foo String where

14+ foo s = s

15+

16+ main = Trace.print $ foo x

src/Language/PureScript/CodeGen/Common.hs+3

@@ -16,6 +16,7 @@

1616module Language.PureScript.CodeGen.Common where

1717

1818import Data.Char

19+import Data.List (intercalate)

1920import Language.PureScript.Names

2021

2122-- |

@@ -127,3 +128,5 @@ nameIsJsReserved name =

127128 , "with"

128129 , "yield" ]

129130

131+moduleNameToJs :: ModuleName -> String

132+moduleNameToJs (ModuleName pns) = intercalate "_" (runProperName `map` pns)

src/Language/PureScript/CodeGen/JS.hs+4−7

@@ -23,7 +23,7 @@ module Language.PureScript.CodeGen.JS (

2323) where

2424

2525import Data.Maybe (fromMaybe, mapMaybe)

26−import Data.List (sortBy, intercalate)

26+import Data.List (sortBy)

2727import Data.Function (on)

2828import Data.Data (Data)

2929import Data.Generics (mkQ, everything)

@@ -55,15 +55,12 @@ moduleToJs :: Options -> Module -> Environment -> Maybe JS

5555moduleToJs opts (Module name decls) env =

5656 case jsDecls of

5757 [] -> Nothing

58− _ -> Just $ JSAssignment (JSAccessor (moduleNameToJS name) (JSVar "_ps")) $

58+ _ -> Just $ JSAssignment (JSAccessor (moduleNameToJs name) (JSVar "_ps")) $

5959 JSApp (JSFunction Nothing ["module"] (JSBlock $ jsDecls ++ [JSReturn $ JSVar "module"]))

60− [(JSBinary Or (JSAccessor (moduleNameToJS name) (JSVar "_ps")) (JSObjectLiteral []))]

60+ [(JSBinary Or (JSAccessor (moduleNameToJs name) (JSVar "_ps")) (JSObjectLiteral []))]

6161 where

6262 jsDecls = (concat $ mapMaybe (\decl -> fmap (map $ optimize opts) $ declToJs opts name decl env) (decls))

6363

64−moduleNameToJS :: ModuleName -> String

65−moduleNameToJS (ModuleName pns) = intercalate "_" (runProperName `map` pns)

66−

6764-- |

6865-- Generate code in the simplified Javascript intermediate representation for a declaration

6966--

@@ -215,7 +212,7 @@ varToJs m e qual@(Qualified _ ident) = go qual

215212-- variable that may have a qualified name.

216213--

217214qualifiedToJS :: ModuleName -> (a -> Ident) -> Qualified a -> JS

218−qualifiedToJS m f (Qualified (Just m') a) | m /= m' = accessor (f a) (JSAccessor (moduleNameToJS m') $ JSVar "_ps")

215+qualifiedToJS m f (Qualified (Just m') a) | m /= m' = accessor (f a) (JSAccessor (moduleNameToJs m') $ JSVar "_ps")

219216qualifiedToJS m f (Qualified _ a) = JSVar $ identToJs (f a)

220217

221218-- |

src/Language/PureScript/Parser/Common.hs+13−4

@@ -203,15 +203,24 @@ natural = PT.natural tokenParser

203203properName :: P.Parsec String u ProperName

204204properName = lexeme $ ProperName <$> P.try ((:) <$> P.upper <*> many P.alphaNum P.<?> "name")

205205

206+-- |

207+-- Parse a module name

208+--

209+moduleName :: P.Parsec String ParseState ModuleName

210+moduleName = ModuleName <$> P.try (sepBy properName dot)

211+

206212-- |

207213-- Parse a qualified name, i.e. M.name or just name

208214--

209215parseQualified :: P.Parsec String ParseState a -> P.Parsec String ParseState (Qualified a)

210−parseQualified parser = qual

216+parseQualified parser = part []

211217 where

212− qual = (Qualified <$> (Just . ModuleName . pure <$> P.try (properName <* delimiter)) <*> parser)

213− <|> (Qualified Nothing <$> P.try parser)

214− delimiter = indented *> dot

218+ part path = (do name <- P.try (properName <* delimiter)

219+ part (updatePath path name))

220+ <|> (Qualified (qual path) <$> P.try parser)

221+ delimiter = indented *> dot <* P.notFollowedBy dot

222+ updatePath path name = path ++ [name]

223+ qual path = if null path then Nothing else Just $ ModuleName path

215224

216225-- |

217226-- Parse an integer or floating point value

src/Language/PureScript/Parser/Declarations.hs+3−3

@@ -89,7 +89,7 @@ parseImportDeclaration :: P.Parsec String ParseState Declaration

8989parseImportDeclaration = do

9090 reserved "import"

9191 indented

92− moduleName <- ModuleName . pure <$> properName

92+ moduleName <- moduleName

9393 idents <- P.optionMaybe $ parens $ commaSep1 (Left <$> parseIdent <|> Right <$> properName)

9494 return $ ImportDeclaration moduleName idents

9595

@@ -138,10 +138,10 @@ parseModule :: P.Parsec String ParseState Module

138138parseModule = do

139139 reserved "module"

140140 indented

141− name <- properName

141+ name <- moduleName

142142 _ <- lexeme $ P.string "where"

143143 decls <- mark (P.many (same *> parseDeclaration))

144− return $ Module (ModuleName [name]) decls

144+ return $ Module name decls

145145

146146-- |

147147-- Parse a collection of modules

src/Language/PureScript/Sugar/TypeClasses.hs+2−2

@@ -36,7 +36,7 @@ import Control.Arrow ((***))

3636import Data.Maybe (fromMaybe)

3737import Data.List (nub)

3838import Data.Generics (mkQ, everything)

39−import Language.PureScript.CodeGen.Common (identToJs)

39+import Language.PureScript.CodeGen.Common (identToJs, moduleNameToJs)

4040

4141type MemberMap = M.Map (ModuleName, ProperName) (String, [(String, Type)])

4242

@@ -159,7 +159,7 @@ typeInstanceDictionaryEntryDeclaration _ _ _ _ _ = error "Invalid declaration in

159159

160160qualifiedToString :: ModuleName -> Qualified ProperName -> String

161161qualifiedToString mn (Qualified Nothing pn) = qualifiedToString mn (Qualified (Just mn) pn)

162−qualifiedToString _ (Qualified (Just mn) pn) = runModuleName mn ++ "_" ++ runProperName pn

162+qualifiedToString _ (Qualified (Just mn) pn) = moduleNameToJs mn ++ "_" ++ runProperName pn

163163

164164-- |

165165-- Generate a name for a type class dictionary, based on the module name, class name and type name