git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Include fixities in externs files, include inline JS decls. #253
859fde9Phil Freeman
src/Language/PureScript/CodeGen/Externs.hs+10−4
compare with golang
unifiedsplit
@@ -35,11 +35,17 @@ import Language.PureScript.Environment
35--
35--
36moduleToPs :: Module -> Environment -> String
36moduleToPs :: Module -> Environment -> String
37moduleToPs (Module _ _ Nothing) _ = error "Module exports were not elaborated in moduleToPs"
37moduleToPs (Module _ _ Nothing) _ = error "Module exports were not elaborated in moduleToPs"
38−moduleToPs (Module moduleName _ (Just exts)) env = intercalate "\n" . execWriter $ do
38+moduleToPs (Module moduleName ds (Just exts)) env = intercalate "\n" . execWriter $ do
39 tell ["module " ++ runModuleName moduleName ++ " where"]
39 tell ["module " ++ runModuleName moduleName ++ " where"]
40+ mapM_ fixityToPs ds
40 mapM_ exportToPs exts
41 mapM_ exportToPs exts
41 where
42 where
42
43
44+ fixityToPs :: Declaration -> Writer [String] ()
45+ fixityToPs (FixityDeclaration (Fixity assoc prec) ident) =
46+ tell [ unwords [ show assoc, show prec, ident ] ]
47+ fixityToPs _ = return ()
48+
43 exportToPs :: DeclarationRef -> Writer [String] ()
49 exportToPs :: DeclarationRef -> Writer [String] ()
44 exportToPs (TypeRef pn dctors) = do
50 exportToPs (TypeRef pn dctors) = do
45 case Qualified (Just moduleName) pn `M.lookup` types env of
51 case Qualified (Just moduleName) pn `M.lookup` types env of
@@ -62,15 +68,15 @@ moduleToPs (Module moduleName _ (Just exts)) env = intercalate "\n" . execWriter
62 exportToPs (ValueRef ident) =
68 exportToPs (ValueRef ident) =
63 case (moduleName, ident) `M.lookup` names env of
69 case (moduleName, ident) `M.lookup` names env of
64 Nothing -> error $ show ident ++ " has no type in exportToPs"
70 Nothing -> error $ show ident ++ " has no type in exportToPs"
65− Just (ty, nameKind) | nameKind == Value || nameKind == Extern ForeignImport ->
71+ Just (ty, nameKind) | nameKind == Value || nameKind == Extern ForeignImport || nameKind == Extern InlineJavascript ->
66 tell ["foreign import " ++ show ident ++ " :: " ++ prettyPrintType ty]
72 tell ["foreign import " ++ show ident ++ " :: " ++ prettyPrintType ty]
67 _ -> return ()
73 _ -> return ()
68 exportToPs (TypeClassRef className) =
74 exportToPs (TypeClassRef className) =
69 case Qualified (Just moduleName) className `M.lookup` typeClasses env of
75 case Qualified (Just moduleName) className `M.lookup` typeClasses env of
70 Nothing -> error $ show className ++ " has no type class definition in exportToPs"
76 Nothing -> error $ show className ++ " has no type class definition in exportToPs"
71− Just (args, ds) -> do
77+ Just (args, members) -> do
72 tell ["class " ++ show className ++ " " ++ unwords args ++ " where"]
78 tell ["class " ++ show className ++ " " ++ unwords args ++ " where"]
73− forM_ (filter (isValueExported . fst) ds) $ \(member ,ty) ->
79+ forM_ (filter (isValueExported . fst) members) $ \(member ,ty) ->
74 tell [ " " ++ show member ++ " :: " ++ prettyPrintType ty ]
80 tell [ " " ++ show member ++ " :: " ++ prettyPrintType ty ]
75 exportToPs (TypeInstanceRef ident) = do
81 exportToPs (TypeInstanceRef ident) = do
76 let TypeClassDictionaryInScope { tcdClassName = className, tcdInstanceTypes = tys, tcdDependencies = deps} =
82 let TypeClassDictionaryInScope { tcdClassName = className, tcdInstanceTypes = tys, tcdDependencies = deps} =
src/Language/PureScript/Declarations.hs+5−1
@@ -33,7 +33,11 @@ type Precedence = Integer
33-- |
33-- |
34-- Associativity for infix operators
34-- Associativity for infix operators
35--
35--
36−data Associativity = Infixl | Infixr deriving (Show, D.Data, D.Typeable)
36+data Associativity = Infixl | Infixr deriving (D.Data, D.Typeable)
37+
38+instance Show Associativity where
39+ show Infixl = "infixl"
40+ show Infixr = "infixr"
37
41
38-- |
42-- |
39-- Fixity data for infix operators
43-- Fixity data for infix operators
src/Language/PureScript/Pretty/Types.hs+7−1
@@ -42,7 +42,6 @@ typeLiterals = mkPattern match
42 match (Skolem s _) = Just $ 's' : show s
42 match (Skolem s _) = Just $ 's' : show s
43 match (ConstrainedType deps ty) = Just $ "(" ++ intercalate ", " (map (\(pn, ty') -> show pn ++ " " ++ unwords (map prettyPrintTypeAtom ty')) deps) ++ ") => " ++ prettyPrintType ty
43 match (ConstrainedType deps ty) = Just $ "(" ++ intercalate ", " (map (\(pn, ty') -> show pn ++ " " ++ unwords (map prettyPrintTypeAtom ty')) deps) ++ ") => " ++ prettyPrintType ty
44 match (SaturatedTypeSynonym name args) = Just $ show name ++ "<" ++ intercalate "," (map prettyPrintTypeAtom args) ++ ">"
44 match (SaturatedTypeSynonym name args) = Just $ show name ++ "<" ++ intercalate "," (map prettyPrintTypeAtom args) ++ ">"
45− match (PrettyPrintForAll idents ty) = Just $ "forall " ++ unwords idents ++ ". " ++ prettyPrintType ty
46 match REmpty = Just "()"
45 match REmpty = Just "()"
47 match row@RCons{} = Just $ '(' : prettyPrintRow row ++ ")"
46 match row@RCons{} = Just $ '(' : prettyPrintRow row ++ ")"
48 match _ = Nothing
47 match _ = Nothing
@@ -100,8 +99,15 @@ matchType = buildPrettyPrinter operators matchTypeAtom
100 OperatorTable [ [ AssocL typeApp $ \f x -> f ++ " " ++ x ]
99 OperatorTable [ [ AssocL typeApp $ \f x -> f ++ " " ++ x ]
101 , [ AssocR appliedFunction $ \arg ret -> arg ++ " -> " ++ ret
100 , [ AssocR appliedFunction $ \arg ret -> arg ++ " -> " ++ ret
102 ]
101 ]
102+ , [ Wrap forall_ $ \idents ty -> "forall " ++ unwords idents ++ ". " ++ ty ]
103 ]
103 ]
104
104
105+forall_ :: Pattern () Type ([String], Type)
106+forall_ = mkPattern match
107+ where
108+ match (PrettyPrintForAll idents ty) = Just (idents, ty)
109+ match _ = Nothing
110+
105-- |
111-- |
106-- Generate a pretty-printed string representing a Type, as it should appear inside parentheses
112-- Generate a pretty-printed string representing a Type, as it should appear inside parentheses
107--
113--