git.iko.soy/elk
on master help sign in
Get docComment parsing working again
f284fabEvan Czaplicki
src/AST/Module.hs+7−7
compare with master
unifiedsplit
@@ -46,7 +46,7 @@ data Header imports =
46 , _name :: Name.Raw
46 , _name :: Name.Raw
47 , _exports :: Var.Listing (A.Located Var.Value)
47 , _exports :: Var.Listing (A.Located Var.Value)
48 , _settings :: SourceSettings
48 , _settings :: SourceSettings
49− , _docs :: Maybe (A.Located Text)
49+ , _docs :: A.Located (Maybe Text)
50 , _imports :: imports
50 , _imports :: imports
51 }
51 }
52
52
@@ -56,9 +56,9 @@ instance Show (Header a) where
56 show (_name header)
56 show (_name header)
57
57
58
58
59−defaultHeader :: imports -> Header imports
59+defaultHeader :: R.Position -> R.Position -> imports -> Header imports
60−defaultHeader imports_ =
60+defaultHeader start end imports_ =
61− Header Normal "Main" Var.openListing emptySettings Nothing imports_
61+ Header Normal "Main" Var.openListing emptySettings (A.at start end Nothing) imports_
62
62
63
63
64
64
@@ -81,7 +81,7 @@ data SourceInfo =
81 Source
81 Source
82 { srcTag :: SourceTag
82 { srcTag :: SourceTag
83 , srcSettings :: SourceSettings
83 , srcSettings :: SourceSettings
84− , srcDocs :: Maybe (A.Located Text)
84+ , srcDocs :: A.Located (Maybe Text)
85 , srcExports :: Var.Listing (A.Located Var.Value)
85 , srcExports :: Var.Listing (A.Located Var.Value)
86 , srcImports :: [UserImport]
86 , srcImports :: [UserImport]
87 , srcDecls :: [Decl.Source]
87 , srcDecls :: [Decl.Source]
@@ -109,7 +109,7 @@ type Valid =
109
109
110data ValidInfo =
110data ValidInfo =
111 Valid
111 Valid
112− { validDocs :: Maybe (A.Located Text)
112+ { validDocs :: A.Located (Maybe Text)
113 , validExports :: Var.Listing (A.Located Var.Value)
113 , validExports :: Var.Listing (A.Located Var.Value)
114 , validImports :: ([DefaultImport], [UserImport])
114 , validImports :: ([DefaultImport], [UserImport])
115 , validDecls :: Decl.Valid
115 , validDecls :: Decl.Valid
@@ -148,7 +148,7 @@ data ImportMethod =
148
148
149data Info program =
149data Info program =
150 Info
150 Info
151− { docs :: Maybe (A.Located Docs.Centralized)
151+ { docs :: A.Located (Maybe Docs.Centralized)
152 , exports :: [Var.Value]
152 , exports :: [Var.Value]
153 , imports :: [Name.Raw]
153 , imports :: [Name.Raw]
154 , program :: program
154 , program :: program
src/Canonicalize.hs+1−1
@@ -79,7 +79,7 @@ module' allCanonicalImports interfaces modul =
79 canonicalDecls
79 canonicalDecls
80
80
81 centralizedDocs =
81 centralizedDocs =
82− fmap (A.map (Docs.centralize canonicalDecls)) docs
82+ A.map (fmap (Docs.centralize canonicalDecls)) docs
83
83
84 typeToPair (A.A _ (D.Type name args body)) =
84 typeToPair (A.A _ (D.Type name args body)) =
85 ( name, (args, body) )
85 ( name, (args, body) )
src/Docs/Check.hs+106−71
@@ -1,84 +1,91 @@
1−module Docs.Check (Result, check) where
1+module Docs.Check (check) where
2
2
3−--import qualified Data.List as List
3+import qualified Data.List as List
4−--import qualified Data.Map as Map
4+import qualified Data.Map as Map
5−--import qualified Data.Set as Set
5+import qualified Data.Set as Set
6−--import qualified Data.Traversable as T
6+import Data.Text (Text)
7
7
8import qualified AST.Variable as Var
8import qualified AST.Variable as Var
9import qualified Docs.AST as Docs
9import qualified Docs.AST as Docs
10−--import qualified Elm.Compiler.Type as Type
10+import qualified Elm.Compiler.Type as Type
11−--import Elm.Utils ((|>))
11+import Elm.Utils ((|>))
12−--import Parse.Helpers
13import qualified Reporting.Annotation as A
12import qualified Reporting.Annotation as A
14−import qualified Reporting.Error.Docs as Error
13+import qualified Reporting.Error as Error
14+import qualified Reporting.Error.Docs as E
15−--import qualified Reporting.Error.Helpers as Error (nearbyNames)
15+import qualified Reporting.Helpers as Help (nearbyNames)
16−--import qualified Reporting.Region as R
16+import qualified Reporting.Region as R
17import qualified Reporting.Result as R
17import qualified Reporting.Result as R
18+import Parse.Helpers
19+ ( Parser, addLocation, getPosition
20+ , spaces, checkSpace, whitespace, SPos(..)
21+ , capVar, lowVar, leftParen, rightParen, infixOp, runAt
22+ , chompUntilDocs, comma, oneOf
23+ )
18
24
19
25
20
26
21−type Result w a =
22− R.Result () w Error.Error a
23−
24−
25-- CHECK DOCUMENTATION
27-- CHECK DOCUMENTATION
26
28
29+
27−check :: [Var.Value] -> Maybe (A.Located Docs.Centralized) -> Result w Docs.Checked
30+check :: [Var.Value] -> A.Located (Maybe Docs.Centralized) -> R.Result () w Error.Error Docs.Checked
28−check exports maybeDocs =
31+check exports (A.A region maybeDocs) =
29− R.ok (error "TODO check docs" exports maybeDocs)
30−{-
31 case maybeDocs of
32 case maybeDocs of
32 Nothing ->
33 Nothing ->
33− R.throw region Error.NoDocs
34+ R.throw region (Error.Docs E.NoDocs)
34
35
35 Just docs ->
36 Just docs ->
36− checkHelp region exports docs
37+ checkHelp region exports docs
37
38
38
39
39−checkHelp :: R.Region -> [Var.Value] -> Docs.Centralized -> Result w Docs.Checked
40+checkHelp :: R.Region -> [Var.Value] -> Docs.Centralized -> R.Result () w Error.Error Docs.Checked
40checkHelp region exports (Docs.Docs comment aliases types values) =
41checkHelp region exports (Docs.Docs comment aliases types values) =
41 let
42 let
42− docNames =
43− commentedNames region comment
44−
45− docSet =
46− Set.fromList (map A.drop docNames)
47−
48− checkCategory checkValue dict =
49− dict
50− |> Map.filterWithKey (\key _ -> Set.member key docSet)
51− |> Map.mapWithKey checkValue
52− |> T.traverse id
53−
54 exportedUnions =
43 exportedUnions =
55 map (\(tipe, Var.Listing tags _) -> (tipe, tags)) (Var.getUnions exports)
44 map (\(tipe, Var.Listing tags _) -> (tipe, tags)) (Var.getUnions exports)
56 in
45 in
46+ do docNames <- parseNames region comment
47+ let docSet = Set.fromList (map A.drop docNames)
48+ R.mapError Error.Docs $
57− (\() -> Docs.Docs comment)
49+ (\() -> Docs.Docs comment)
58− <$> checkModuleComment region exports docNames
50+ <$> checkModuleComment region exports docNames
59− <*> checkCategory (checkComment Docs.aliasComment) aliases
51+ <*> checkCategory docSet (checkComment Docs.aliasComment) aliases
60− <*> checkCategory (checkUnion exportedUnions) types
52+ <*> checkCategory docSet (checkUnion exportedUnions) types
61− <*> checkCategory checkValue values
53+ <*> checkCategory docSet checkValue values
54+
62
55
56+type Result w a = R.Result () w E.Error a
63
57
58+
59+checkCategory
60+ :: Set.Set Text
61+ -> (Text -> a -> Result w b)
62+ -> Map.Map Text a
63+ -> Result w (Map.Map Text b)
64+checkCategory docSet check dict =
65+ dict
66+ |> Map.filterWithKey (\key _ -> Set.member key docSet)
67+ |> Map.mapWithKey check
68+ |> traverse id
69+
70+
64−checkComment :: (a -> Maybe String) -> String -> A.Located a -> Result w (A.Located a)
71+checkComment :: (a -> Maybe Text) -> Text -> A.Located a -> Result w (A.Located a)
65checkComment getComment name (A.A region value) =
72checkComment getComment name (A.A region value) =
66 case getComment value of
73 case getComment value of
67 Nothing ->
74 Nothing ->
68− R.throw region (Error.NoComment name)
75+ R.throw region (E.NoComment name)
69
76
70 Just _ ->
77 Just _ ->
71 R.ok (A.A region value)
78 R.ok (A.A region value)
72
79
73
80
74−checkUnion :: [(String, [String])] -> String -> A.Located Docs.Union -> Result w (A.Located Docs.Union)
81+checkUnion :: [(Text, [Text])] -> Text -> A.Located Docs.Union -> Result w (A.Located Docs.Union)
75checkUnion exportedUnions name value =
82checkUnion exportedUnions name value =
76 const
83 const
77 <$> filterUnionTags exportedUnions name value
84 <$> filterUnionTags exportedUnions name value
78 <*> checkComment Docs.unionComment name value
85 <*> checkComment Docs.unionComment name value
79
86
80
87
81−filterUnionTags :: [(String, [String])] -> String -> A.Located Docs.Union -> Result w (A.Located Docs.Union)
88+filterUnionTags :: [(Text, [Text])] -> Text -> A.Located Docs.Union -> Result w (A.Located Docs.Union)
82filterUnionTags exportedUnions name (A.A region union@(Docs.Union _ _ ctors)) =
89filterUnionTags exportedUnions name (A.A region union@(Docs.Union _ _ ctors)) =
83 let
90 let
84 exportedTags =
91 exportedTags =
@@ -91,26 +98,28 @@ filterUnionTags exportedUnions name (A.A region union@(Docs.Union _ _ ctors)) =
91
98
92
99
93
100
94−checkValue :: String -> A.Located (Docs.Value (Maybe Type.Type)) -> Result w (A.Located (Docs.Value Type.Type))
101+checkValue :: Text -> A.Located (Docs.Value (Maybe Type.Type)) -> Result w (A.Located (Docs.Value Type.Type))
95checkValue name value =
102checkValue name value =
96 const
103 const
97 <$> hasType name value
104 <$> hasType name value
98 <*> checkComment Docs.valueComment name value
105 <*> checkComment Docs.valueComment name value
99
106
100
107
101−hasType :: String -> A.Located (Docs.Value (Maybe Type.Type)) -> Result w (A.Located (Docs.Value Type.Type))
108+hasType :: Text -> A.Located (Docs.Value (Maybe Type.Type)) -> Result w (A.Located (Docs.Value Type.Type))
102hasType name (A.A region value) =
109hasType name (A.A region value) =
103 case Docs.valueType value of
110 case Docs.valueType value of
104 Just tipe ->
111 Just tipe ->
105 R.ok (A.A region (value { Docs.valueType = tipe }))
112 R.ok (A.A region (value { Docs.valueType = tipe }))
106
113
107 Nothing ->
114 Nothing ->
108− R.throw region (Error.NoType name)
115+ R.throw region (E.NoType name)
116+
109
117
110
118
111-- CHECK MODULE COMMENT
119-- CHECK MODULE COMMENT
112
120
121+
113−checkModuleComment :: R.Region -> [Var.Value] -> [A.Located String] -> Result w ()
122+checkModuleComment :: R.Region -> [Var.Value] -> [A.Located Text] -> Result w ()
114checkModuleComment docRegion exports locatedDocNames =
123checkModuleComment docRegion exports locatedDocNames =
115 let
124 let
116 exportNames =
125 exportNames =
@@ -123,12 +132,12 @@ checkModuleComment docRegion exports locatedDocNames =
123 Map.fromList (map (\(A.A region name) -> (name, region)) locatedDocNames)
132 Map.fromList (map (\(A.A region name) -> (name, region)) locatedDocNames)
124
133
125 extraNameError (name, region) =
134 extraNameError (name, region) =
126− R.throw region (Error.OnlyInDocs name (Error.nearbyNames id name exportNames))
135+ R.throw region (E.OnlyInDocs name (Help.nearbyNames id name exportNames))
127
136
128 docErrors =
137 docErrors =
129 Map.difference docDict exportDict
138 Map.difference docDict exportDict
130 |> Map.toList
139 |> Map.toList
131− |> T.traverse extraNameError
140+ |> traverse extraNameError
132
141
133 namesOnlyInExports =
142 namesOnlyInExports =
134 Map.difference exportDict docDict
143 Map.difference exportDict docDict
@@ -139,41 +148,67 @@ checkModuleComment docRegion exports locatedDocNames =
139 if null namesOnlyInExports then
148 if null namesOnlyInExports then
140 R.ok ()
149 R.ok ()
141 else
150 else
142− R.throw docRegion (Error.OnlyInExports namesOnlyInExports)
151+ R.throw docRegion (E.OnlyInExports namesOnlyInExports)
143 in
152 in
144 (\_ _ -> ())
153 (\_ _ -> ())
145 <$> exportErrors
154 <$> exportErrors
146 <*> docErrors
155 <*> docErrors
147
156
148
157
149−commentedNames :: R.Region -> String -> [A.Located String]
158+
159+-- PARSE DOC COMMENT
160+
161+
162+parseNames :: R.Region -> Text -> R.Result () w Error.Error [A.Located Text]
150−commentedNames (R.Region (R.Position line column) _) comment =
163+parseNames (R.Region (R.Position row col) _) comment =
151− let
164+ case runAt row (col + 3) (namesParser []) comment of
152− nameParser =
165+ Left (A.A region parseError) ->
153− choice
166+ R.throw region (Error.Syntax parseError)
154− [ do string "@docs"
167+
168+ Right names ->
169+ R.ok names
170+
171+
172+
173+namesParser :: [A.Located Text] -> Parser [A.Located Text]
174+namesParser names =
175+ do isDocs <- chompUntilDocs
176+ if isDocs then namesParserHelp names else return names
177+
178+
179+namesParserHelp :: [A.Located Text] -> Parser [A.Located Text]
180+namesParserHelp names =
181+ do pos <- getPosition
155− whitespace
182+ (SPos spos) <- whitespace
156− commaSep1 (addLocation (var <|> parens infixOp))
183+ if pos == spos
157− , do anyUntil simpleNewline
184+ then namesParser names
185+ else namesParser =<< chompNames names
186+
187+
188+chompNames :: [A.Located Text] -> Parser [A.Located Text]
189+chompNames names =
190+ do name <- addLocation (oneOf [ lowVar, capVar, operator ])
191+ spos <- whitespace
192+ oneOf
193+ [ do checkSpace spos
194+ comma
195+ spaces
196+ chompNames (name:names)
158− return []
197+ , return names
159 ]
198 ]
160
199
161− docCommentParser =
162− do setPosition (newPos "docs" line (column + 3))
163− concat <$> many nameParser
164− in
165− case parse docCommentParser comment of
166− Left _ ->
167− []
168
200
169− Right names ->
201+operator :: Parser Text
170− names
202+operator =
203+ do leftParen
204+ op <- infixOp
205+ rightParen
206+ return op
171
207
172
208
173−valueName :: Var.Value -> String
209+valueName :: Var.Value -> Text
174valueName value =
210valueName value =
175 case value of
211 case value of
176 Var.Value name -> name
212 Var.Value name -> name
177 Var.Alias name -> name
213 Var.Alias name -> name
178 Var.Union name _ -> name
214 Var.Union name _ -> name
179−-}
src/Elm/Compiler.hs+2−2
@@ -96,7 +96,7 @@ compile context source interfaces =
96
96
97 (Result.Result oneLocalizer warnings answer) =
97 (Result.Result oneLocalizer warnings answer) =
98 do modul <- Compile.compile packageName dependencies interfaces source
98 do modul <- Compile.compile packageName dependencies interfaces source
99− docs <- Result.format Error.Docs (docsGen isExposed modul)
99+ docs <- Result.format id (docsGen isExposed modul)
100
100
101 let interface = Module.toInterface packageName modul
101 let interface = Module.toInterface packageName modul
102 let javascript = {-# SCC elm_compiler_generate #-} JS.generate modul
102 let javascript = {-# SCC elm_compiler_generate #-} JS.generate modul
@@ -124,7 +124,7 @@ data Result = Result
124 }
124 }
125
125
126
126
127−docsGen :: Bool -> Module.Optimized -> Docs.Result w (Maybe Docs.Documentation)
127+docsGen :: Bool -> Module.Optimized -> Result.Result () w Error.Error (Maybe Docs.Documentation)
128docsGen isExposed (Module.Module name _ info) =
128docsGen isExposed (Module.Module name _ info) =
129 if not isExposed then
129 if not isExposed then
130 Result.ok Nothing
130 Result.ok Nothing
src/Parse/Module.hs+11−7
@@ -17,10 +17,12 @@ import qualified Reporting.Region as R
17
17
18header :: Parser (Module.Header [Module.UserImport])
18header :: Parser (Module.Header [Module.UserImport])
19header =
19header =
20+ do start <- getPosition
20− do freshLine
21+ freshLine
22+ end <- getPosition
21 oneOf
23 oneOf
22 [ fullHeader
24 [ fullHeader
23− , Module.defaultHeader <$> chompImports []
25+ , Module.defaultHeader start end <$> chompImports []
24 ]
26 ]
25
27
26
28
@@ -38,8 +40,10 @@ fullHeader =
38 keyword "exposing" -- TODO <?> "something like `exposing (..)` which replaced `where` in 0.17"
40 keyword "exposing" -- TODO <?> "something like `exposing (..)` which replaced `where` in 0.17"
39 spaces
41 spaces
40 exports <- listing (addLocation listingValue)
42 exports <- listing (addLocation listingValue)
43+ start <- getPosition
41 freshLine
44 freshLine
45+ end <- getPosition
42− docs <- maybeDocComment
46+ docs <- maybeDocComment start end
43 imports <- chompImports []
47 imports <- chompImports []
44 return (Module.Header tag name exports settings docs imports)
48 return (Module.Header tag name exports settings docs imports)
45
49
@@ -119,13 +123,13 @@ setting =
119-- DOC COMMENTS
123-- DOC COMMENTS
120
124
121
125
122−maybeDocComment :: Parser (Maybe (A.Located Text))
126+maybeDocComment :: R.Position -> R.Position -> Parser (A.Located (Maybe Text))
123−maybeDocComment =
127+maybeDocComment start end =
124 oneOf
128 oneOf
125 [ do doc <- addLocation docComment
129 [ do doc <- addLocation docComment
126 freshLine
130 freshLine
127− return (Just doc)
131+ return (A.map Just doc)
128− , return Nothing
132+ , return (A.at start end Nothing)
129 ]
133 ]
130
134
131
135
src/Parse/Primitives.hs+52−5
@@ -2,7 +2,7 @@
2{-# LANGUAGE BangPatterns, Rank2Types, UnboxedTuples, OverloadedStrings #-}
2{-# LANGUAGE BangPatterns, Rank2Types, UnboxedTuples, OverloadedStrings #-}
3module Parse.Primitives
3module Parse.Primitives
4 ( Parser
4 ( Parser
5− , run
5+ , run, runAt
6 , try, failure, deadend, expecting, endOfFile
6 , try, failure, deadend, expecting, endOfFile
7 , oneOf
7 , oneOf
8 , symbol, keyword, keywords
8 , symbol, keyword, keywords
@@ -10,7 +10,7 @@ module Parse.Primitives
10 , getPosition, getCol
10 , getPosition, getCol
11 , getIndent, setIndent
11 , getIndent, setIndent
12 , SPos(..), whitespace
12 , SPos(..), whitespace
13− , docComment
13+ , docComment, chompUntilDocs
14 , string, character
14 , string, character
15 , digit, number
15 , digit, number
16 , shaderSource, shaderFailure
16 , shaderSource, shaderFailure
@@ -92,8 +92,13 @@ loneTheory row col theory =
92
92
93
93
94run :: Parser a -> Text -> Either (A.Located E.Error) a
94run :: Parser a -> Text -> Either (A.Located E.Error) a
95+run parser text =
96+ runAt 1 1 parser text
97+
98+
99+runAt :: Int -> Int -> Parser a -> Text -> Either (A.Located E.Error) a
95−run parser (Text.Text array offset length) =
100+runAt sRow sCol parser (Text.Text array offset length) =
96− case _run parser (State array offset length 0 1 1) Ok Err Ok Err of
101+ case _run parser (State array offset length 0 sRow sCol) Ok Err Ok Err of
97 Ok value _ ->
102 Ok value _ ->
98 Right value
103 Right value
99
104
@@ -270,7 +275,7 @@ moveCursor array offset length row col =
270 let
275 let
271 !word = Text.unsafeIndex array offset
276 !word = Text.unsafeIndex array offset
272 in
277 in
273− if word == 0x000A then
278+ if word == 0x000A {- \n -} then
274 moveCursor array (offset + 1) (length - 1) (row + 1) 1
279 moveCursor array (offset + 1) (length - 1) (row + 1) 1
275
280
276 else if word < 0xD800 || word > 0xDBFF then
281 else if word < 0xD800 || word > 0xDBFF then
@@ -652,6 +657,48 @@ docComment =
652 (State array newOffset newLength indent newRow newCol)
657 (State array newOffset newLength indent newRow newCol)
653
658
654
659
660+chompUntilDocs :: Parser Bool
661+chompUntilDocs =
662+ Parser $ \(State array offset length indent row col) cok _ _ _ ->
663+ let
664+ (# isStart, newOffset, newLength, newRow, newCol #) =
665+ eatDocs array offset length row col
666+ in
667+ cok isStart (State array newOffset newLength indent newRow newCol)
668+
669+
670+eatDocs :: Text.Array -> Int -> Int -> Int -> Int -> (# Bool, Int, Int, Int, Int #)
671+eatDocs array offset length row col =
672+ if length == 0 then
673+ (# False, offset, length, row, col #)
674+
675+ else if isDocsStart array offset length then
676+ (# True, offset + 5, length - 5, row, col + 5 #)
677+
678+ else
679+ let
680+ !word = Text.unsafeIndex array offset
681+ in
682+ if word == 0x000A {- \n -} then
683+ eatDocs array (offset + 1) (length - 1) (row + 1) 1
684+
685+ else if word < 0xD800 || word > 0xDBFF then
686+ eatDocs array (offset + 1) (length - 1) row (col + 1)
687+
688+ else
689+ eatDocs array (offset + 2) (length - 2) row (col + 1)
690+
691+
692+isDocsStart :: Text.Array -> Int -> Int -> Bool
693+isDocsStart array offset length =
694+ length >= 5
695+ && Text.unsafeIndex array offset == 0x0040 {- @ -}
696+ && Text.unsafeIndex array (offset + 1) == 0x0064 {- d -}
697+ && Text.unsafeIndex array (offset + 2) == 0x006F {- o -}
698+ && Text.unsafeIndex array (offset + 3) == 0x0063 {- c -}
699+ && Text.unsafeIndex array (offset + 4) == 0x0073 {- s -}
700+
701+
655
702
656-- STRINGS
703-- STRINGS
657
704