@@ -3,8 +3,8 @@
33module Elm.Kernel
44 ( Content(..)
55 , Chunk(..)
6− , Dep(..)
7− , parser
6+ , fromFile
7+ , countFields
88 )
99 where
1010
@@ -15,7 +15,6 @@ import Data.Coerce (coerce)
1515import qualified Data.List as List
1616import qualified Data.Map as Map
1717import qualified Data.Name as Name
18−import qualified Data.Set as Set
1918import qualified Data.Utf8 as Utf8
2019import Data.Word (Word8, Word16)
2120import Foreign.Ptr (Ptr, plusPtr)
@@ -26,28 +25,14 @@ import qualified Elm.Package as Pkg
2625import qualified Parse.Module as Module
2726import qualified Parse.Variable as Var
2827import Parse.Utils
29−import Parse.Primitives hiding (Parser, State)
28+import Parse.Primitives hiding (Parser, fromFile)
3029import qualified Parse.Primitives as P
3130import qualified Reporting.Annotation as A
3231import qualified Reporting.Error.Syntax as E
3332
3433
3534
36−-- CONTENT
37−
38−
39−data Content =
40− Content [Chunk] (Set.Set Dep)
41−
42−
43−data Dep
44− = ElmDep ModuleName.Canonical Name.Name
45− | KernelDep Name.Name
46− deriving (Eq, Ord)
47−
48−
49−
50−-- CHUNKS
35+-- CHUNK
5136
5237
5338data Chunk
@@ -65,22 +50,55 @@ data UNCHECKED
6550
6651
6752
68−-- PARSE
53+-- COUNT FIELDS
54+
55+
56+countFields :: [Chunk] -> Map.Map Name.Name Int
57+countFields chunks =
58+ foldr addField Map.empty chunks
59+
60+
61+addField :: Chunk -> Map.Map Name.Name Int -> Map.Map Name.Name Int
62+addField chunk fields =
63+ case chunk of
64+ JS _ -> fields
65+ ElmVar _ _ -> fields
66+ JsVar _ _ -> fields
67+ ElmField f -> Map.insertWith (+) f 1 fields
68+ JsField _ -> fields
69+ JsEnum _ -> fields
70+ Debug -> fields
71+ Prod -> fields
72+
73+
74+
75+-- FROM FILE
76+
77+
78+data Content =
79+ Content [Src.Import] [Chunk]
80+
81+
82+type Foreigns =
83+ Map.Map ModuleName.Raw Pkg.Name
6984
7085
71−type ImportDict =
72− Map.Map Name.Name [Pkg.Name]
86+fromFile :: Pkg.Name -> Foreigns -> FilePath -> IO (Maybe Content)
87+fromFile pkg foreigns path =
88+ do result <- P.fromFile (parser pkg foreigns) path
89+ case result of
90+ P.Ok content _ -> return (Just content)
91+ P.Err _ _ _ _ -> return Nothing
7392
7493
75−parser :: ImportDict -> Parser Content
76−parser importDict =
94+parser :: Pkg.Name -> Foreigns -> Parser Content
95+parser pkg foreigns =
7796 do word2 0x2F 0x2A {-/*-} E.XXX
7897 Module.freshLine
7998 imports <- Module.chompImports []
8099 word2 0x2A 0x2F {-*/-} E.XXX
81− let (vtable, deps) = processImports importDict imports
82− chunks <- parseChunks vtable Map.empty Map.empty
83− return $ Content chunks deps
100+ chunks <- parseChunks (toVarTable pkg foreigns imports) Map.empty Map.empty
101+ return (Content imports chunks)
84102
85103
86104
@@ -100,17 +118,11 @@ parseChunks vtable enums fields =
100118 cerr row col ctx E.XXX
101119
102120
103−addJS :: Ptr Word8 -> Ptr Word8 -> [Chunk] -> [Chunk]
104−addJS start end revChunks =
105− if start == end
106− then revChunks
107− else JS (Utf8.fromPtr start end) : revChunks
108−
109−
110121chompChunks :: VarTable -> Enums -> Fields -> Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> Ptr Word8 -> [Chunk] -> (# [Chunk], Ptr Word8, Word16, Word16 #)
111122chompChunks vs es fs pos end row col lastPos revChunks =
112123 if pos >= end then
113− (# reverse (addJS lastPos end revChunks), pos, row, col #)
124+ let !js = Utf8.fromPtr lastPos end in
125+ (# reverse (JS js : revChunks), pos, row, col #)
114126
115127 else
116128 let !word = unsafeIndex pos in
@@ -120,7 +132,8 @@ chompChunks vs es fs pos end row col lastPos revChunks =
120132 !pos3 = plusPtr pos 3
121133 in
122134 if pos3 <= end && unsafeIndex pos1 == 0x5F {-_-} then
123− chompTag vs es fs pos3 end row (col + 3) (addJS lastPos pos revChunks)
135+ let !js = Utf8.fromPtr lastPos pos in
136+ chompTag vs es fs pos3 end row (col + 3) (JS js : revChunks)
124137 else
125138 chompChunks vs es fs pos1 end row (col + 1) lastPos revChunks
126139
@@ -143,8 +156,11 @@ chompTag vs es fs pos end row col revChunks =
143156 !word = unsafeIndex tagPos
144157 in
145158 if word == 0x24 {-$-} then
159+ let
160+ !name = Name.fromPtr pos newPos
161+ in
146162 chompChunks vs es fs newPos end row newCol newPos $
147− ElmField (Name.fromPtr pos newPos) : revChunks
163+ ElmField name : revChunks
148164 else
149165 let
150166 !name = Name.fromPtr tagPos newPos
@@ -230,60 +246,34 @@ type VarTable =
230246 Map.Map Name.Name Chunk
231247
232248
233−type State =
234− (VarTable, Set.Set Dep)
235−
249+toVarTable :: Pkg.Name -> Foreigns -> [Src.Import] -> VarTable
250+toVarTable pkg foreigns imports =
251+ List.foldl' (addImport pkg foreigns) Map.empty imports
236252
237−processImports :: ImportDict -> [Src.Import] -> State
238−processImports importDict imports =
239− List.foldl' (addImport importDict) (Map.empty, Set.empty) imports
240253
241−
242−addImport :: ImportDict -> State -> Src.Import -> State
243−addImport importDict state (Src.Import (A.At _ home) maybeAlias exposing) =
244− if Name.isKernel home then
254+addImport :: Pkg.Name -> Foreigns -> VarTable -> Src.Import -> VarTable
255+addImport pkg foreigns vtable (Src.Import (A.At _ importName) maybeAlias exposing) =
256+ if Name.isKernel importName then
245257 case maybeAlias of
246258 Just _ ->
247− error ("Cannot use aliases on kernel import of: " ++ Name.toChars home)
259+ error ("cannot use `as` with kernel import of: " ++ Name.toChars importName)
248260
249261 Nothing ->
250− addKernelImport (Name.getKernel home) exposing state
251−
252− else
253− case Map.lookup home importDict of
254− Just [pkg] ->
255262 let
256− canonicalHome = ModuleName.Canonical pkg home
257− prefix = toPrefix home maybeAlias
263+ home = Name.getKernel importName
264+ add table name =
265+ Map.insert (Name.sepBy 0x5F {-_-} home name) (JsVar home name) table
258266 in
259− addNormalImport canonicalHome prefix exposing state
260−
261− _ ->
262− error ("Cannot find kernel import of: " ++ Name.toChars home)
263−
267+ List.foldl' add vtable (toNames exposing)
264268
265−-- INVARIANT: the `home` is the * in `Elm.Kernel.*`
266−--
267−addKernelImport :: Name.Name -> Src.Exposing -> State -> State
268−addKernelImport home exposing (vtable, deps) =
269− let
270− addVar table name =
271− Map.insert (Name.sepBy 0x5F {-_-} home name) (JsVar home name) table
272− in
273− ( List.foldl' addVar vtable (toNames exposing)
274− , Set.insert (KernelDep home) deps
275− )
276−
277−
278−addNormalImport :: ModuleName.Canonical -> Name.Name -> Src.Exposing -> State -> State
279−addNormalImport home prefix exposing state =
280− let
281− addVar (vtable, deps) name =
282− ( Map.insert (Name.sepBy 0x5F {-_-} prefix name) (ElmVar home name) vtable
283− , Set.insert (ElmDep home name) deps
284− )
285− in
286− List.foldl' addVar state (toNames exposing)
269+ else
270+ let
271+ home = ModuleName.Canonical (Map.findWithDefault pkg importName foreigns) importName
272+ prefix = toPrefix importName maybeAlias
273+ add table name =
274+ Map.insert (Name.sepBy 0x5F {-_-} prefix name) (ElmVar home name) table
275+ in
276+ List.foldl' add vtable (toNames exposing)
287277
288278
289279toPrefix :: Name.Name -> Maybe Name.Name -> Name.Name
@@ -303,7 +293,7 @@ toNames :: Src.Exposing -> [Name.Name]
303293toNames exposing =
304294 case exposing of
305295 Src.Open ->
306− error "Cannot have `exposing (..)` in kernel code."
296+ error "cannot have `exposing (..)` in kernel code."
307297
308298 Src.Explicit exposedList ->
309299 map toName exposedList