git.iko.soy/elk
on master help sign in
remove Parse.Docs since the logic is all in Elm.Docs now
a4518afEvan Czaplicki
compiler/src/Parse/Docs.hsdeleted−275
compare with master
unifiedsplit
@@ -1,275 +0,0 @@
1−module Parse.Docs
2− ( Docs(..)
3− , parser
4− )
5− where
6−
7−
8−
9−-- DOCS
10−
11−
12−data Docs =
13− Docs
14− { _exposed :: [A.Located Name.Name]
15− , _overview :: Utf8.String
16− , _listed :: [A.Located Name.Name]
17− , _comments :: Map.Map Name.Name Utf8.String
18− }
19−
20−
21−
22−-- PARSER
23−
24−
25−parser :: Parser Docs
26−parser =
27− error "TODO implement docs parser"
28−
29−
30−chompUntilDocs :: Parser Bool
31−chompUntilDocs =
32− P.Parser $ \(P.State fp offset terminal indent row col ctx) cok _ _ _ ->
33− let
34− (# isStart, newOffset, newRow, newCol #) =
35− eatDocs fp offset terminal row col
36−
37− !newState =
38− P.State fp newOffset terminal indent newRow newCol ctx
39− in
40− cok isStart newState
41−
42−
43−eatDocs :: ForeignPtr Word8 -> Int -> Int -> Word16 -> Word16 -> (# Bool, Int, Word16, Word16 #)
44−eatDocs fp offset terminal row col =
45− if offset >= terminal then
46− (# False, offset, row, col #)
47−
48− else if isDocsStart fp offset terminal then
49− (# True, offset + 5, row, col + 5 #)
50−
51− else
52− let !word = P.unsafeIndex fp offset in
53− if word == 0x0A {- \n -} then
54− eatDocs fp (offset + 1) terminal (row + 1) 1
55−
56− else
57− let !newOffset = offset + P.getCharWidth fp offset terminal word in
58− eatDocs fp newOffset terminal row (col + 1)
59−
60−
61−isDocsStart :: ForeignPtr Word8 -> Int -> Int -> Bool
62−isDocsStart =
63− let (B.PS dfp doff dlen) = docsStart in
64− P.isSubstring dfp doff dlen
65−
66−
67−{-# NOINLINE docsStart #-}
68−docsStart :: B.ByteString
69−docsStart =
70− "@docs"
71−
72−
73−chompOverview :: [A.Located Name.Name] -> Parser [A.Located Name.Name]
74−chompOverview names =
75− do isDocs <- chompUntilDocs
76− if isDocs
77− then chompOverviewHelp names
78− else return names
79−
80−
81−chompOverviewHelp :: [A.Located Name.Name] -> Parser [A.Located Name.Name]
82−chompOverviewHelp names =
83− do pos <- getPosition
84− (SPos spos) <- whitespace
85− if pos == spos
86− then chompOverview names
87− else chompOverview =<< chompDocs names
88−
89−
90−chompDocs :: [A.Located Name.Name] -> Parser [A.Located Name.Name]
91−chompDocs names =
92− do name <- addLocation (oneOf SE.XXX [ Var.lower, Var.upper, chompBinop ])
93− spos <- whitespace
94− oneOf SE.XXX
95− [ do checkSpace spos
96− word1 0x2C {-,-} SE.XXX
97− spaces
98− chompDocs (name:names)
99− , return (name:names)
100− ]
101−
102−
103−chompBinop :: Parser Name.Name
104−chompBinop =
105− do word1 0x28 {-(-} SE.XXX
106− name <- Symbol.binop
107− word1 0x29 {-)-} SE.XXX
108− return name
109−
110−
111−
112−
113−-- CHECK NAMES
114−
115−
116−type Result i w a =
117− Result.Result i w E.Error a
118−
119−
120−type Dups =
121− Map.Map Name.Name (OneOrMore.OneOrMore A.Region)
122−
123−
124−checkNames :: Map.Map Name.Name (A.Located Can.Export) -> [A.Located Name.Name] -> Result i w ()
125−checkNames exports names =
126− do docs <- Map.traverseWithKey isUnique (List.foldl' addName Map.empty names)
127− let overlap = Map.size (Map.intersection docs exports)
128− if Map.size exports == overlap && overlap == Map.size docs
129− then Result.ok ()
130− else
131− do _ <- Map.traverseWithKey onlyInDocs (Map.difference docs exports)
132− _ <- Map.traverseWithKey onlyInExports (Map.difference exports docs)
133− Result.ok ()
134−
135−
136−addName :: Dups -> A.Located Name.Name -> Dups
137−addName dict (A.At region name) =
138− Map.insertWith OneOrMore.more name (OneOrMore.one region) dict
139−
140−
141−isUnique :: Name.Name -> OneOrMore.OneOrMore A.Region -> Result i w A.Region
142−isUnique name regions =
143− case regions of
144− OneOrMore.One region ->
145− Result.ok region
146−
147− OneOrMore.More _ _ ->
148− let (r1:r2:_) = OneOrMore.toList regions in
149− Result.throw (E.Duplicate name r1 r2)
150−
151−
152−onlyInDocs :: Name.Name -> A.Region -> Result i w a
153−onlyInDocs name region =
154− Result.throw $ E.OnlyInDocs name region
155−
156−
157−onlyInExports :: Name.Name -> A.Located Can.Export -> Result i w a
158−onlyInExports name (A.At region _) =
159− Result.throw $ E.OnlyInExports name region
160−
161−
162−
163−-- CHECK EXPORTS
164−
165−
166−data Info =
167− Info
168− { _iComments :: Map.Map Name.Name Comment
169− , _iValues :: Types
170− , _iUnions :: Map.Map Name.Name Can.Union
171− , _iAliases :: Map.Map Name.Name Can.Alias
172− , _iBinops :: Map.Map Name.Name Can.Binop
173− , _iEffects :: Can.Effects
174− }
175−
176−
177−checkExport :: Info -> Name.Name -> A.Located Can.Export -> Result i w (Module -> Module)
178−checkExport info name (A.At region export) =
179− case export of
180− Can.ExportValue ->
181− do tipe <- getType name info
182− comment <- getComment region name info
183− Result.ok $ \m ->
184− m { _values = Map.insert name (Value comment tipe) (_values m) }
185−
186− Can.ExportBinop ->
187− do let (Can.Binop_ assoc prec realName) = _iBinops info ! name
188− tipe <- getType realName info
189− comment <- getComment region realName info
190− Result.ok $ \m ->
191− m { _binops = Map.insert name (Binop comment tipe assoc prec) (_binops m) }
192−
193− Can.ExportAlias ->
194− do let (Can.Alias tvars tipe) = _iAliases info ! name
195− comment <- getComment region name info
196− Result.ok $ \m ->
197− m { _aliases = Map.insert name (Alias comment tvars (Extract.fromType tipe)) (_aliases m) }
198−
199− Can.ExportUnionOpen ->
200− do let (Can.Union tvars ctors _ _) = _iUnions info ! name
201− comment <- getComment region name info
202− Result.ok $ \m ->
203− m { _unions = Map.insert name (Union comment tvars (map dector ctors)) (_unions m) }
204−
205− Can.ExportUnionClosed ->
206− do let (Can.Union tvars _ _ _) = _iUnions info ! name
207− comment <- getComment region name info
208− Result.ok $ \m ->
209− m { _unions = Map.insert name (Union comment tvars []) (_unions m) }
210−
211− Can.ExportPort ->
212− do tipe <- getType name info
213− comment <- getComment region name info
214− Result.ok $ \m ->
215− m { _values = Map.insert name (Value comment tipe) (_values m) }
216−
217−
218−getComment :: A.Region -> Name.Name -> Info -> Result i w Comment
219−getComment region name info =
220− case Map.lookup name (_iComments info) of
221− Nothing ->
222− Result.throw (E.NoComment name region)
223−
224− Just comment ->
225− Result.ok comment
226−
227−
228−getType :: Name.Name -> Info -> Result i w Type.Type
229−getType name info =
230− case _iValues info ! name of
231− A.At defRegion Nothing ->
232− Result.throw (E.NoAnnotation name defRegion)
233−
234− A.At _ (Just tipe) ->
235− Result.ok (Extract.fromType tipe)
236−
237−
238−dector :: Can.Ctor -> (Name.Name, [Type.Type])
239−dector (Can.Ctor name _ _ args) =
240− ( name, map Extract.fromType args )
241−
242−
243−
244−-- GATHER TYPES
245−
246−
247−type Types =
248− Map.Map Name.Name (A.Located (Maybe Can.Type))
249−
250−
251−gatherTypes :: Can.Decls -> Types -> Types
252−gatherTypes decls types =
253− case decls of
254− Can.Declare def subDecls ->
255− gatherTypes subDecls (addDef types def)
256−
257− Can.DeclareRec defs subDecls ->
258− gatherTypes subDecls (List.foldl' addDef types defs)
259−
260− Can.SaveTheEnvironment ->
261− types
262−
263−
264−addDef :: Types -> Can.Def -> Types
265−addDef types def =
266− case def of
267− Can.Def (A.At region name) _ _ ->
268− Map.insert name (A.At region Nothing) types
269−
270− Can.TypedDef (A.At region name) _ typedArgs _ resultType ->
271− let
272− tipe =
273− foldr Can.TLambda resultType (map snd typedArgs)
274− in
275− Map.insert name (A.At region (Just tipe)) types