git.iko.soy/elk
on master help sign in
Upgrade Elm/ from String to Text
2203dd6Evan Czaplicki
src/Elm/Compiler.hs+11−28
compare with master
unifiedsplit
@@ -12,8 +12,8 @@ module Elm.Compiler
12import qualified Data.Aeson as Json
12import qualified Data.Aeson as Json
13import qualified Data.Map as Map
13import qualified Data.Map as Map
14import qualified Data.Text.Lazy as LazyText
14import qualified Data.Text.Lazy as LazyText
15+import Data.Text (Text)
15import System.IO (Handle)
16import System.IO (Handle)
16−import qualified Text.Parsec.Error as Parsec
17
17
18import qualified AST.Module as Module
18import qualified AST.Module as Module
19import qualified AST.Module.Name as ModuleName
19import qualified AST.Module.Name as ModuleName
@@ -25,13 +25,11 @@ import qualified Elm.Compiler.Version
25import qualified Elm.Docs as Docs
25import qualified Elm.Docs as Docs
26import qualified Elm.Package as Package
26import qualified Elm.Package as Package
27import qualified Generate.JavaScript as JS
27import qualified Generate.JavaScript as JS
28−import qualified Parse.Helpers as Parse (parse)
28+import qualified Parse.Helpers as Parse (run)
29import qualified Parse.Module as Parse (header)
29import qualified Parse.Module as Parse (header)
30import qualified Reporting.Annotation as A
30import qualified Reporting.Annotation as A
31import qualified Reporting.Bag as Bag
31import qualified Reporting.Bag as Bag
32import qualified Reporting.Error as Error
32import qualified Reporting.Error as Error
33−import qualified Reporting.Error.Syntax as SyntaxError
34−import qualified Reporting.Region as Region
35import qualified Reporting.Render.Type as RenderType
33import qualified Reporting.Render.Type as RenderType
36import qualified Reporting.Report as Report
34import qualified Reporting.Report as Report
37import qualified Reporting.Result as Result
35import qualified Reporting.Result as Result
@@ -57,28 +55,17 @@ data Tag
57 | Port
55 | Port
58
56
59
57
60−parseDependencies
61− :: Package.Name
62− -> String
63− -> Either Error (Tag, PublicModule.Raw, [PublicModule.Raw])
58+parseDependencies :: Package.Name -> Text -> Either Error (Tag, PublicModule.Raw, [PublicModule.Raw])
64parseDependencies pkgName sourceCode =
59parseDependencies pkgName sourceCode =
65− case Parse.parse Parse.header sourceCode of
60+ case Parse.run Parse.header sourceCode of
66 Right header ->
61 Right header ->
67 Right $ getDeps pkgName header
62 Right $ getDeps pkgName header
68
63
69− Left parseError ->
64+ Left err ->
70− let
65+ Left (error "TODO parse deps" err)
71− pos = Region.fromSourcePos (Parsec.errorPos parseError)
72− msgs = Parsec.errorMessages parseError
73− err = Error.Syntax (SyntaxError.Parse msgs)
74− in
75− Left (Error (A.at pos pos err))
76
66
77
67
78−getDeps
79− :: Package.Name
80− -> Module.Header [Module.UserImport]
81− -> (Tag, PublicModule.Raw, [PublicModule.Raw])
68+getDeps :: Package.Name -> Module.Header [Module.UserImport] -> (Tag, PublicModule.Raw, [PublicModule.Raw])
82getDeps pkgName (Module.Header sourceTag name _ _ _ imports) =
69getDeps pkgName (Module.Header sourceTag name _ _ _ imports) =
83 let
70 let
84 tag =
71 tag =
@@ -101,12 +88,7 @@ getDeps pkgName (Module.Header sourceTag name _ _ _ imports) =
101
88
102
89
103{-| Compiles Elm source code to JavaScript. -}
90{-| Compiles Elm source code to JavaScript. -}
104−compile
105− :: Context
106− -> String
107− -> PublicModule.Interfaces
108− -> (Localizer, [Warning], Either [Error] Result)
91+compile :: Context -> Text -> PublicModule.Interfaces -> (Localizer, [Warning], Either [Error] Result)
109−
110compile context source interfaces =
92compile context source interfaces =
111 let
93 let
112 (Context packageName isExposed dependencies) =
94 (Context packageName isExposed dependencies) =
@@ -117,7 +99,7 @@ compile context source interfaces =
117 docs <- Result.format Error.Docs (docsGen isExposed modul)
99 docs <- Result.format Error.Docs (docsGen isExposed modul)
118
100
119 let interface = Module.toInterface packageName modul
101 let interface = Module.toInterface packageName modul
120− let javascript = JS.generate modul
102+ let javascript = {-# SCC elm_compiler_generate #-} JS.generate modul
121
103
122 return (Result docs interface javascript)
104 return (Result docs interface javascript)
123 in
105 in
@@ -127,7 +109,8 @@ compile context source interfaces =
127 )
109 )
128
110
129
111
130−data Context = Context
112+data Context =
113+ Context
131 { _packageName :: Package.Name
114 { _packageName :: Package.Name
132 , _isExposed :: Bool
115 , _isExposed :: Bool
133 , _dependencies :: [PublicModule.Canonical]
116 , _dependencies :: [PublicModule.Canonical]
src/Elm/Compiler/Imports.hs+16−12
@@ -1,5 +1,9 @@
1+{-# OPTIONS_GHC -Wall #-}
2+{-# LANGUAGE OverloadedStrings #-}
1module Elm.Compiler.Imports (defaults) where
3module Elm.Compiler.Imports (defaults) where
2
4
5+import Data.Text (Text)
6+
3import qualified AST.Module as Module
7import qualified AST.Module as Module
4import qualified AST.Variable as Var
8import qualified AST.Variable as Var
5
9
@@ -12,16 +16,16 @@ import qualified AST.Variable as Var
12
16
13defaults :: [Module.DefaultImport]
17defaults :: [Module.DefaultImport]
14defaults =
18defaults =
15− [ ["Basics"] ==> Module.ImportMethod Nothing Var.openListing
19+ [ "Basics" ==> Module.ImportMethod Nothing Var.openListing
16− , ["Debug"] ==> Module.ImportMethod Nothing Var.closedListing
20+ , "Debug" ==> Module.ImportMethod Nothing Var.closedListing
17− , ["List"] ==> exposing [Var.Value "::"]
21+ , "List" ==> exposing [Var.Value "::"]
18− , ["Maybe"] ==> exposing [Var.Union "Maybe" Var.openListing]
22+ , "Maybe" ==> exposing [Var.Union "Maybe" Var.openListing]
19− , ["Result"] ==> exposing [Var.Union "Result" Var.openListing]
23+ , "Result" ==> exposing [Var.Union "Result" Var.openListing]
20− , ["String"] ==> Module.ImportMethod Nothing Var.closedListing
24+ , "String" ==> Module.ImportMethod Nothing Var.closedListing
21− , ["Tuple"] ==> Module.ImportMethod Nothing Var.closedListing
25+ , "Tuple" ==> Module.ImportMethod Nothing Var.closedListing
22− , ["Platform"] ==> exposing [closedType "Program"]
26+ , "Platform" ==> exposing [closedType "Program"]
23− , ["Platform","Cmd"] ==> named "Cmd" [closedType "Cmd", Var.Value "!"]
27+ , "Platform.Cmd" ==> named "Cmd" [closedType "Cmd", Var.Value "!"]
24− , ["Platform","Sub"] ==> named "Sub" [closedType "Sub"]
28+ , "Platform.Sub" ==> named "Sub" [closedType "Sub"]
25 ]
29 ]
26
30
27
31
@@ -30,12 +34,12 @@ exposing vars =
30 Module.ImportMethod Nothing (Var.listing vars)
34 Module.ImportMethod Nothing (Var.listing vars)
31
35
32
36
33−closedType :: String -> Var.Value
37+closedType :: Text -> Var.Value
34closedType name =
38closedType name =
35 Var.Union name Var.closedListing
39 Var.Union name Var.closedListing
36
40
37
41
38−named :: String -> [Var.Value] -> Module.ImportMethod
42+named :: Text -> [Var.Value] -> Module.ImportMethod
39named name vars =
43named name vars =
40 Module.ImportMethod (Just name) (Var.listing vars)
44 Module.ImportMethod (Just name) (Var.listing vars)
41
45
src/Elm/Compiler/Module.hs+17−14
@@ -1,4 +1,5 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2+{-# LANGUAGE OverloadedStrings #-}
2module Elm.Compiler.Module
3module Elm.Compiler.Module
3 ( Interface, Interfaces
4 ( Interface, Interfaces
4 , ModuleName.Raw
5 , ModuleName.Raw
@@ -16,6 +17,7 @@ import qualified Data.Char as Char
16import qualified Data.List as List
17import qualified Data.List as List
17import qualified Data.Map as Map
18import qualified Data.Map as Map
18import qualified Data.Text as Text
19import qualified Data.Text as Text
20+import Data.Text (Text)
19import System.FilePath ((</>))
21import System.FilePath ((</>))
20
22
21import qualified AST.Module as Module
23import qualified AST.Module as Module
@@ -35,7 +37,7 @@ type Interface = Module.Interface
35type Interfaces = Module.Interfaces
37type Interfaces = Module.Interfaces
36
38
37
39
38−interfaceAliasedTypes :: Interface -> Map.Map String PublicType.Type
40+interfaceAliasedTypes :: Interface -> Map.Map Text PublicType.Type
39interfaceAliasedTypes interface =
41interfaceAliasedTypes interface =
40 Map.map Extract.extract (Module.iTypes interface)
42 Map.map Extract.extract (Module.iTypes interface)
41
43
@@ -57,7 +59,7 @@ fromJson (RawForJson raw) =
57 raw
59 raw
58
60
59
61
60−qualifiedVar :: ModuleName.Canonical -> String -> String
62+qualifiedVar :: ModuleName.Canonical -> Text -> Text
61qualifiedVar =
63qualifiedVar =
62 Gen.qualified
64 Gen.qualified
63
65
@@ -67,13 +69,13 @@ qualifiedVar =
67
69
68
70
69nameToPath :: ModuleName.Raw -> FilePath
71nameToPath :: ModuleName.Raw -> FilePath
70−nameToPath names =
72+nameToPath name =
71− List.foldl1 (</>) names
73+ List.foldl1 (</>) (map Text.unpack (Text.splitOn "." name))
72
74
73
75
74nameToString :: ModuleName.Raw -> String
76nameToString :: ModuleName.Raw -> String
75−nameToString names =
77+nameToString name =
76− List.intercalate "." names
78+ Text.unpack name
77
79
78
80
79nameFromString :: String -> Maybe ModuleName.Raw
81nameFromString :: String -> Maybe ModuleName.Raw
@@ -83,7 +85,7 @@ nameFromString =
83
85
84hyphenate :: ModuleName.Raw -> String
86hyphenate :: ModuleName.Raw -> String
85hyphenate names =
87hyphenate names =
86− List.intercalate "-" names
88+ Text.unpack (Text.replace "." "-" names)
87
89
88
90
89dehyphenate :: String -> Maybe ModuleName.Raw
91dehyphenate :: String -> Maybe ModuleName.Raw
@@ -93,21 +95,22 @@ dehyphenate =
93
95
94fromString :: Char -> String -> Maybe ModuleName.Raw
96fromString :: Char -> String -> Maybe ModuleName.Raw
95fromString sep raw =
97fromString sep raw =
96− mapM isLegit names
98+ do chunks <- mapM isLegit names
99+ return (Text.pack (List.intercalate "." chunks))
97 where
100 where
98 names =
101 names =
99 filter (/= [sep]) (List.groupBy (\a b -> a /= sep && b /= sep) raw)
102 filter (/= [sep]) (List.groupBy (\a b -> a /= sep && b /= sep) raw)
100
103
101 isLegit name =
104 isLegit name =
102 case name of
105 case name of
106+ [] ->
103− [] -> Nothing
107+ Nothing
108+
104− char:rest ->
109+ char:rest ->
105− if Char.isUpper char && all legitChar rest
110+ if Char.isUpper char && all legitChar rest then Just name else Nothing
106− then Just name
107− else Nothing
108
111
109 legitChar char =
112 legitChar char =
110− Char.isAlphaNum char || char `elem` "_'"
113+ Char.isAlphaNum char || char == '_'
111
114
112
115
113
116
src/Elm/Compiler/Type.hs+60−51
@@ -1,3 +1,4 @@
1+{-# OPTIONS_GHC -Wall #-}
1{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE OverloadedStrings #-}
2module Elm.Compiler.Type
3module Elm.Compiler.Type
3 ( Type(..), toString
4 ( Type(..), toString
@@ -11,6 +12,7 @@ import qualified Data.Aeson as Json
11import qualified Data.Aeson.Types as Json
12import qualified Data.Aeson.Types as Json
12import qualified Data.ByteString.Lazy.Char8 as BS
13import qualified Data.ByteString.Lazy.Char8 as BS
13import qualified Data.Text as Text
14import qualified Data.Text as Text
15+import Data.Text (Text)
14import Text.PrettyPrint as P
16import Text.PrettyPrint as P
15
17
16import qualified AST.Helpers as Help
18import qualified AST.Helpers as Help
@@ -24,17 +26,17 @@ import qualified Reporting.Annotation as A
24
26
25data Type
27data Type
26 = Lambda Type Type
28 = Lambda Type Type
27− | Var String
29+ | Var Text
28− | Type String
30+ | Type Text
29 | App Type [Type]
31 | App Type [Type]
30− | Record [(String, Type)] (Maybe Type)
32+ | Record [(Text, Type)] (Maybe Type)
31
33
32
34
33data Program =
35data Program =
34 Program
36 Program
35 { _message :: Type
37 { _message :: Type
36− , _aliases :: [( String, [String], Type )]
38+ , _aliases :: [( Text, [Text], Type )]
37− , _unions :: [( String, [String], [(String, [Type])] )]
39+ , _unions :: [( Text, [Text], [(Text, [Type])] )]
38 }
40 }
39
41
40
42
@@ -65,27 +67,32 @@ toDoc context tipe =
65 _ -> P.parens lambda
67 _ -> P.parens lambda
66
68
67 Var name ->
69 Var name ->
68− P.text name
70+ P.text (Text.unpack name)
69
71
70 Type name ->
72 Type name ->
71− P.text (if name == "_Tuple0" then "()" else name)
73+ P.text (Text.unpack (if name == "_Tuple0" then "()" else name))
72−
74+
73− App (Type name) args
75+ App (Type name) args ->
74− | name == "_Tuple0" ->
76+ if name == "_Tuple0" then
75− P.text "()"
77+ P.text "()"
76−
78+
77− | Help.isTuple name ->
79+ else if Help.isTuple name then
78− P.sep
80+ P.sep
79− [ P.cat (zipWith (<+>) (P.lparen : repeat P.comma) (map (toDoc None) args))
81+ [ P.cat (zipWith (<+>) (P.lparen : repeat P.comma) (map (toDoc None) args))
80− , P.rparen
82+ , P.rparen
81− ]
83+ ]
82−
84+
83− | otherwise ->
85+ else
86+ let
87+ application =
88+ P.hang
89+ (P.text (Text.unpack name))
90+ 2
84− let adt = P.hang (P.text name) 2 (P.sep $ map (toDoc ADT) args)
91+ (P.sep $ map (toDoc ADT) args)
85− in
92+ in
86− case (context, args) of
93+ case (context, args) of
87− (ADT, _ : _) -> P.parens adt
94+ (ADT, _ : _) -> P.parens application
88− _ -> adt
95+ _ -> application
89
96
90 App _ _ ->
97 App _ _ ->
91 error $
98 error $
@@ -105,7 +112,7 @@ toDoc context tipe =
105
112
106 (fields, Just x) ->
113 (fields, Just x) ->
107 P.hang
114 P.hang
108− (P.lbrace <+> P.text x <+> P.text "|")
115+ (P.lbrace <+> P.text (Text.unpack x) <+> P.text "|")
109 4
116 4
110 (P.sep
117 (P.sep
111 [ P.sep (P.punctuate P.comma (map prettyField fields))
118 [ P.sep (P.punctuate P.comma (map prettyField fields))
@@ -113,8 +120,8 @@ toDoc context tipe =
113 ]
120 ]
114 )
121 )
115 where
122 where
116− prettyField (field, tipe) =
123+ prettyField (field, fieldType) =
117− P.text field <+> P.text ":" <+> toDoc None tipe
124+ P.text (Text.unpack field) <+> P.text ":" <+> toDoc None fieldType
118
125
119
126
120collectLambdas :: Type -> [Type]
127collectLambdas :: Type -> [Type]
@@ -124,19 +131,22 @@ collectLambdas tipe =
124 _ -> [tipe]
131 _ -> [tipe]
125
132
126
133
127−flattenRecord :: Type -> ( [(String, Type)], Maybe String )
134+flattenRecord :: Type -> ( [(Text, Type)], Maybe Text )
128flattenRecord tipe =
135flattenRecord tipe =
129− case tipe of
136+ case tipe of
137+ Var x ->
130− Var x -> ([], Just x)
138+ ([], Just x)
131
139
132− Record fields Nothing -> (fields, Nothing)
140+ Record fields Nothing ->
141+ (fields, Nothing)
133
142
134− Record fields (Just ext) ->
143+ Record fields (Just ext) ->
135− let (fields',ext') = flattenRecord ext
144+ let (fields',ext') = flattenRecord ext
136− in
145+ in
137− (fields' ++ fields, ext')
146+ (fields' ++ fields, ext')
138
147
148+ _ ->
139− _ -> error "Trying to flatten ill-formed record."
149+ error "Trying to flatten ill-formed record."
140
150
141
151
142
152
@@ -157,9 +167,13 @@ instance Json.FromJSON Type where
157 ++ BS.unpack (Json.encode value)
167 ++ BS.unpack (Json.encode value)
158 in
168 in
159 case value of
169 case value of
160− Json.String text ->
170+ Json.String txt ->
171+ case Parse.run Type.expression (Text.replace "'" "_" txt) of
172+ Left err ->
173+ failure err
174+
175+ Right (tipe, _, _) ->
161− either failure (return . fromRawType) $
176+ return (fromRawType tipe)
162− Parse.parse Type.expr (replacePrimes (Text.unpack text))
163
177
164 Json.Object obj ->
178 Json.Object obj ->
165 fromObject obj
179 fromObject obj
@@ -168,11 +182,6 @@ instance Json.FromJSON Type where
168 failure ()
182 failure ()
169
183
170
184
171−replacePrimes :: String -> String
172−replacePrimes string =
173− map (\c -> if c == '\'' then '_' else c) string
174−
175−
176fromObject :: Json.Object -> Json.Parser Type
185fromObject :: Json.Object -> Json.Parser Type
177fromObject obj =
186fromObject obj =
178 do tag <- obj .: "tag"
187 do tag <- obj .: "tag"
@@ -206,7 +215,7 @@ fromRawType (A.A _ astType) =
206 Var x
215 Var x
207
216
208 Type.RType var ->
217 Type.RType var ->
209− Type (Var.toString var)
218+ Type (Var.toText var)
210
219
211 Type.RApp t ts ->
220 Type.RApp t ts ->
212 App (fromRawType t) (map fromRawType ts)
221 App (fromRawType t) (map fromRawType ts)
@@ -228,22 +237,22 @@ instance Json.ToJSON Program where
228 ]
237 ]
229
238
230
239
231−toAliasField :: ( String, [String], Type ) -> Json.Pair
240+toAliasField :: ( Text, [Text], Type ) -> Json.Pair
232toAliasField ( name, args, tipe ) =
241toAliasField ( name, args, tipe ) =
233− Text.pack name .= Json.object
242+ name .= Json.object
234 [ "args" .= args
243 [ "args" .= args
235 , "type" .= tipe
244 , "type" .= tipe
236 ]
245 ]
237
246
238
247
239−toUnionField :: ( String, [String], [(String, [Type])] ) -> Json.Pair
248+toUnionField :: ( Text, [Text], [(Text, [Type])] ) -> Json.Pair
240toUnionField ( name, args, constructors ) =
249toUnionField ( name, args, constructors ) =
241− Text.pack name .= Json.object
250+ name .= Json.object
242 [ "args" .= args
251 [ "args" .= args
243 , "tags" .= Json.object (map toCtorObject constructors)
252 , "tags" .= Json.object (map toCtorObject constructors)
244 ]
253 ]
245
254
246
255
247−toCtorObject :: (String, [Type]) -> Json.Pair
256+toCtorObject :: (Text, [Type]) -> Json.Pair
248toCtorObject (name, args) =
257toCtorObject (name, args) =
249− Text.pack name .= args
258+ name .= args
src/Elm/Compiler/Type/Extract.hs+13−10
@@ -1,4 +1,5 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2+{-# LANGUAGE OverloadedStrings #-}
2module Elm.Compiler.Type.Extract
3module Elm.Compiler.Type.Extract
3 ( extract
4 ( extract
4 , extractProgram
5 , extractProgram
@@ -9,6 +10,8 @@ import qualified Control.Monad.Writer as Writer
9import qualified Data.Map as Map
10import qualified Data.Map as Map
10import qualified Data.Maybe as Maybe
11import qualified Data.Maybe as Maybe
11import qualified Data.Set as Set
12import qualified Data.Set as Set
13+import Data.Text (Text)
14+
12import qualified AST.Module as Module
15import qualified AST.Module as Module
13import qualified AST.Module.Name as ModuleName
16import qualified AST.Module.Name as ModuleName
14import qualified AST.Type as T
17import qualified AST.Type as T
@@ -45,11 +48,11 @@ extractHelp astType =
45 Lambda <$> extractHelp arg <*> extractHelp result
48 Lambda <$> extractHelp arg <*> extractHelp result
46
49
47 T.Var x ->
50 T.Var x ->
48− return $ Var x
51+ return (Var x)
49
52
50 T.Type var ->
53 T.Type var ->
51 do Writer.tell ( Set.empty, Set.singleton var )
54 do Writer.tell ( Set.empty, Set.singleton var )
52− return $ Type $ Var.toString var
55+ return (Type (Var.toText var))
53
56
54 T.App constructor args ->
57 T.App constructor args ->
55 App <$> extractHelp constructor <*> traverse extractHelp args
58 App <$> extractHelp constructor <*> traverse extractHelp args
@@ -62,7 +65,7 @@ extractHelp astType =
62 T.Aliased name args aliasedType ->
65 T.Aliased name args aliasedType ->
63 do Writer.tell ( Set.singleton name, Set.empty )
66 do Writer.tell ( Set.singleton name, Set.empty )
64 _ <- extractHelp (T.dealias args aliasedType)
67 _ <- extractHelp (T.dealias args aliasedType)
65− App (Type (Var.toString name)) <$> traverse (extractHelp . snd) args
68+ App (Type (Var.toText name)) <$> traverse (extractHelp . snd) args
66
69
67
70
68
71
@@ -82,15 +85,15 @@ extractProgram interfaces name =
82
85
83 let (msgType, msgDeps) = Writer.runWriter (extractHelp message)
86 let (msgType, msgDeps) = Writer.runWriter (extractHelp message)
84 let (aliases, unions) = extractTransitive interfaces mempty msgDeps
87 let (aliases, unions) = extractTransitive interfaces mempty msgDeps
85− Just $ Program msgType aliases unions
88+ Just (Program msgType aliases unions)
86
89
87
90
88type Alias =
91type Alias =
89− ( String, [String], Type )
92+ ( Text, [Text], Type )
90
93
91
94
92type Union =
95type Union =
93− ( String, [String], [(String, [Type])] )
96+ ( Text, [Text], [(Text, [Type])] )
94
97
95
98
96extractTransitive :: Module.Interfaces -> Deps -> Deps -> ( [Alias], [Union] )
99extractTransitive :: Module.Interfaces -> Deps -> Deps -> ( [Alias], [Union] )
@@ -120,7 +123,7 @@ extractAlias :: Module.Interfaces -> Var.Canonical -> Writer.Writer Deps (Maybe
120extractAlias interfaces var =
123extractAlias interfaces var =
121 let
124 let
122 toAlias (args, tipe) =
125 toAlias (args, tipe) =
123− (,,) (Var.toString var) args <$> extractHelp tipe
126+ (,,) (Var.toText var) args <$> extractHelp tipe
124 in
127 in
125 traverse toAlias (get Module.iAliases interfaces var)
128 traverse toAlias (get Module.iAliases interfaces var)
126
129
@@ -129,20 +132,20 @@ extractUnion :: Module.Interfaces -> Var.Canonical -> Writer.Writer Deps (Maybe
129extractUnion interfaces var =
132extractUnion interfaces var =
130 let
133 let
131 toUnion (args, constructors) =
134 toUnion (args, constructors) =
132− (,,) (Var.toString var) args
135+ (,,) (Var.toText var) args
133 <$> traverse (traverse (traverse extractHelp)) constructors
136 <$> traverse (traverse (traverse extractHelp)) constructors
134 in
137 in
135 traverse toUnion (get Module.iUnions interfaces var)
138 traverse toUnion (get Module.iUnions interfaces var)
136
139
137
140
138−get :: (Module.Interface -> Map.Map String a) -> Module.Interfaces -> Var.Canonical -> Maybe a
141+get :: (Module.Interface -> Map.Map Text a) -> Module.Interfaces -> Var.Canonical -> Maybe a
139get getInfo interfaces var =
142get getInfo interfaces var =
140 do (home, name) <- getHome var
143 do (home, name) <- getHome var
141 iface <- Map.lookup home interfaces
144 iface <- Map.lookup home interfaces
142 Map.lookup name (getInfo iface)
145 Map.lookup name (getInfo iface)
143
146
144
147
145−getHome :: Var.Canonical -> Maybe (ModuleName.Canonical, String)
148+getHome :: Var.Canonical -> Maybe (ModuleName.Canonical, Text)
146getHome (Var.Canonical home name) =
149getHome (Var.Canonical home name) =
147 case home of
150 case home of
148 Var.BuiltIn ->
151 Var.BuiltIn ->
src/Elm/Utils.hs+8−6
@@ -1,5 +1,6 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE FlexibleContexts #-}
3+{-# LANGUAGE OverloadedStrings #-}
3module Elm.Utils
4module Elm.Utils
4 ( (|>), (<|)
5 ( (|>), (<|)
5 , run, unwrappedRun
6 , run, unwrappedRun
@@ -8,7 +9,7 @@ module Elm.Utils
8 ) where
9 ) where
9
10
10import Control.Monad.Except (MonadError, MonadIO, liftIO, throwError)
11import Control.Monad.Except (MonadError, MonadIO, liftIO, throwError)
11−import qualified Data.List as List
12+import Data.Text (Text)
12import System.Exit (ExitCode(ExitSuccess, ExitFailure))
13import System.Exit (ExitCode(ExitSuccess, ExitFailure))
13import System.Process (readProcessWithExitCode)
14import System.Process (readProcessWithExitCode)
14
15
@@ -98,11 +99,12 @@ missingExe command =
98
99
99-- DECL CHECKER
100-- DECL CHECKER
100
101
102+
101−isDeclaration :: String -> Maybe String
103+isDeclaration :: Text -> Maybe [Text]
102−isDeclaration str =
104+isDeclaration source =
103− case Parse.parse Parse.def str of
105+ case Parse.run Parse.definition source of
104− Right (A.A _ (Source.Definition pattern _)) ->
106+ Right (A.A _ (Source.Definition pattern _), _, _) ->
105− Just (List.intercalate "$" (Pattern.boundVarList pattern))
107+ Just (Pattern.boundVarList pattern)
106
108
107 _ ->
109 _ ->
108 Nothing
110 Nothing