git.iko.soy/elk
on master help sign in
Simplify Docs.AST to simplify API diffing
774aebdEvan Czaplicki
src/AST/Declaration.hs+27−14
compare with master
unifiedsplit
@@ -2,6 +2,8 @@
2{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE OverloadedStrings #-}
3module AST.Declaration where
3module AST.Declaration where
4
4
5+import Prelude hiding (Either(..))
6+import Control.Monad (liftM3)
5import Data.Binary
7import Data.Binary
6import Data.Text (Text)
8import Data.Text (Text)
7
9
@@ -105,30 +107,40 @@ data Infix =
105 }
107 }
106
108
107
109
108−data Assoc = L | N | R
110+data Assoc = Left | Non | Right
109 deriving (Eq)
111 deriving (Eq)
110
112
111
113
114+defaultAssociativity :: Assoc
115+defaultAssociativity =
116+ Left
117+
118+
119+defaultPrecedence :: Int
120+defaultPrecedence =
121+ 9
122+
123+
112assocToText :: Assoc -> Text
124assocToText :: Assoc -> Text
113assocToText assoc =
125assocToText assoc =
114 case assoc of
126 case assoc of
115− L ->
127+ Left ->
116 "left"
128 "left"
117
129
118− N ->
130+ Non ->
119 "non"
131 "non"
120
132
121− R ->
133+ Right ->
122 "right"
134 "right"
123
135
124
136
125
137
126−-- BINARY CONVERSION
138+-- BINARY
127
139
128
140
129instance Binary Infix where
141instance Binary Infix where
130 get =
142 get =
131− Infix <$> get <*> get <*> get
143+ liftM3 Infix get get get
132
144
133 put (Infix op assoc prec) =
145 put (Infix op assoc prec) =
134 do put op
146 do put op
@@ -139,15 +151,16 @@ instance Binary Infix where
139instance Binary Assoc where
151instance Binary Assoc where
140 get =
152 get =
141 do n <- getWord8
153 do n <- getWord8
154+ return $
142− return $ case n of
155+ case n of
143− 0 -> L
156+ 0 -> Left
144− 1 -> N
157+ 1 -> Non
145− 2 -> R
158+ 2 -> Right
146− _ -> error "Error reading valid associativity from serialized string"
159+ _ -> error "Error reading valid associativity from serialized string"
147
160
148 put assoc =
161 put assoc =
149 putWord8 $
162 putWord8 $
150 case assoc of
163 case assoc of
151− L -> 0
164+ Left -> 0
152− N -> 1
165+ Non -> 1
153− R -> 2
166+ Right -> 2
src/Canonicalize/Binops.hs+10−5
@@ -5,7 +5,7 @@ import Prelude hiding (last)
5import qualified Data.Map as Map
5import qualified Data.Map as Map
6import Data.Text (Text)
6import Data.Text (Text)
7
7
8−import AST.Declaration (Assoc(..))
8+import qualified AST.Declaration as Decl
9import qualified AST.Expression.Canonical as C
9import qualified AST.Expression.Canonical as C
10import qualified AST.Variable as Var
10import qualified AST.Variable as Var
11import qualified Canonicalize.Environment as Env
11import qualified Canonicalize.Environment as Env
@@ -23,7 +23,7 @@ import qualified Reporting.Result as R
23data Op =
23data Op =
24 Op
24 Op
25 { _name :: Var.Canonical
25 { _name :: Var.Canonical
26− , _assoc :: Assoc
26+ , _assoc :: Decl.Assoc
27 , _prec :: Int
27 , _prec :: Int
28 , _region :: Region.Region
28 , _region :: Region.Region
29 }
29 }
@@ -32,10 +32,15 @@ data Op =
32canonicalize :: Env.Env -> A.Located Text -> Var.Result Op
32canonicalize :: Env.Env -> A.Located Text -> Var.Result Op
33canonicalize env (A.A region op) =
33canonicalize env (A.A region op) =
34 do name <- Var.variable region env op
34 do name <- Var.variable region env op
35− let (assoc, prec) = Map.findWithDefault (L, 9) name (Env._infixes env)
35+ let (assoc, prec) = Map.findWithDefault defaults name (Env._infixes env)
36 return $ Op name assoc prec region
36 return $ Op name assoc prec region
37
37
38
38
39+defaults :: ( Decl.Assoc, Int )
40+defaults =
41+ ( Decl.defaultAssociativity, Decl.defaultPrecedence )
42+
43+
39
44
40-- FLATTEN
45-- FLATTEN
41
46
@@ -94,10 +99,10 @@ flattenHelp makeBinop rootOp@(Op _ rootAssoc rootPrec _) middle last =
94 else
99 else
95
100
96 case (rootAssoc, assoc) of
101 case (rootAssoc, assoc) of
97− (L, L) ->
102+ (Decl.Left, Decl.Left) ->
98 flattenHelp (\right -> binop name (makeBinop expr) right) op rest last
103 flattenHelp (\right -> binop name (makeBinop expr) right) op rest last
99
104
100− (R, R) ->
105+ (Decl.Right, Decl.Right) ->
101 flattenHelp (\right -> makeBinop (binop name expr right)) op rest last
106 flattenHelp (\right -> makeBinop (binop name expr right)) op rest last
102
107
103 (_, _) ->
108 (_, _) ->
src/Docs/AST.hs+35−47
@@ -1,9 +1,10 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2module Docs.AST
2module Docs.AST
3− ( Centralized(..), Checked(..)
3+ ( Docs(..), Centralized, Checked
4+ , Entry(..), Raw, Good
5+ , Union(..)
6+ , Alias(..)
4 , Value(..), RawValue, GoodValue
7 , Value(..), RawValue, GoodValue
5− , Alias(..), RawAlias, GoodAlias
6− , Union(..), RawUnion, GoodUnion
7 )
8 )
8 where
9 where
9
10
@@ -11,6 +12,7 @@ module Docs.AST
11import qualified Data.Map as Map
12import qualified Data.Map as Map
12import Data.Text (Text)
13import Data.Text (Text)
13
14
15+import qualified AST.Declaration as Decl
14import qualified Elm.Compiler.Type as Type
16import qualified Elm.Compiler.Type as Type
15import qualified Reporting.Annotation as A
17import qualified Reporting.Annotation as A
16
18
@@ -19,73 +21,59 @@ import qualified Reporting.Annotation as A
19-- DOCS
21-- DOCS
20
22
21
23
22−data Centralized =
24+data Docs unions aliases values =
23− Centralized
25+ Docs
24− { comment :: Text
26+ { _overview :: Text
25− , values :: Map.Map Text (A.Located RawValue)
26− , aliases :: Map.Map Text (A.Located RawAlias)
27− , unions :: Map.Map Text (A.Located RawUnion)
28− }
29−
30−
31−data Checked =
32− Checked
33− { _comment :: Text
34− , _values :: Map.Map Text GoodValue
35− , _aliases :: Map.Map Text GoodAlias
36− , _unions :: Map.Map Text GoodUnion
27+ , _unions :: Map.Map Text unions
28+ , _aliases :: Map.Map Text aliases
29+ , _values :: Map.Map Text values
37 }
30 }
38
31
39
32
33+type Centralized =
34+ Docs (Raw Union) (Raw Alias) (Raw RawValue)
40
35
41−-- VALUES
42
36
43−
37+type Checked =
44−data Value comment tipe =
38+ Docs (Good Union) (Good Alias) (Good GoodValue)
45− Value
46− { valueComment :: comment
47− , valueType :: tipe
48− , valueAssocPrec :: Maybe (Text,Int)
49− }
50
39
51
40
52−type RawValue = Value (Maybe Text) (Maybe Type.Type)
53
41
54−
42+-- ENTRY
55−type GoodValue = Value Text Type.Type
56
43
57
44
45+data Entry comment details =
46+ Entry
47+ { _comment :: !comment
48+ , _details :: !details
49+ }
58
50
59−-- ALIAS
60
51
52+type Raw a =
53+ A.Located (Entry (Maybe Text) a)
61
54
62−data Alias comment =
63− Alias
64− { aliasComment :: comment
65− , aliasArgs :: [Text]
66− , aliasType :: Type.Type
67− }
68
55
56+type Good a =
57+ Entry Text a
69
58
70−type RawAlias = Alias (Maybe Text)
71
59
72
60
73−type GoodAlias = Alias Text
61+-- INFO
74
62
75
63
64+data Alias =
65+ Alias [Text] Type.Type
76
66
77−-- UNION
78
67
68+data Union =
69+ Union [Text] [(Text, [Type.Type])]
79
70
80−data Union comment =
81− Union
82− { unionComment :: comment
83− , unionArgs :: [Text]
84− , unionCases :: [(Text, [Type.Type])]
85− }
86
71
72+data Value tipe
73+ = Value tipe
74+ | Infix tipe Decl.Assoc Int
87
75
88−type RawUnion = Union (Maybe Text)
89
76
77+type RawValue = Value (Maybe Type.Type)
90
78
91−type GoodUnion = Union Text
79+type GoodValue = Value Type.Type
src/Docs/Centralize.hs+64−44
@@ -5,76 +5,96 @@ import qualified Data.Map as Map
5import qualified Data.Maybe as Maybe
5import qualified Data.Maybe as Maybe
6import Data.Text (Text)
6import Data.Text (Text)
7
7
8−import qualified AST.Declaration as D
8+import qualified AST.Declaration as Decl
9import qualified AST.Expression.Canonical as Canonical
9import qualified AST.Expression.Canonical as Canonical
10+import qualified AST.Helpers as Help
10import qualified AST.Pattern as Pattern
11import qualified AST.Pattern as Pattern
11import qualified AST.Type as Type
12import qualified AST.Type as Type
12import qualified Docs.AST as Docs
13import qualified Docs.AST as Docs
13import qualified Elm.Compiler.Type.Extract as Extract
14import qualified Elm.Compiler.Type.Extract as Extract
14import qualified Reporting.Annotation as A
15import qualified Reporting.Annotation as A
16+import qualified Reporting.Region as R
15
17
16
18
17
19
18−-- CENTRALIZE DOCUMENTATION
20+-- CENTRALIZE
19
21
20
22
21−centralize :: D.Canonical -> Text -> Docs.Centralized
23+centralize :: Decl.Canonical -> Text -> Docs.Centralized
22−centralize (D.Decls defs unions aliases infixes) comment =
24+centralize (Decl.Decls defs unions aliases infixes) overview =
23 let
25 let
24 infixDict =
26 infixDict =
25− Map.fromList (map infixToEntry infixes)
27+ Map.fromList (map toInfixPair infixes)
26 in
28 in
27− Docs.Centralized
29+ Docs.Docs
28− comment
30+ overview
29− (Map.fromList (Maybe.mapMaybe (defToEntry infixDict) defs))
30− (Map.fromList (map aliasToEntry aliases))
31 (Map.fromList (map unionToEntry unions))
31 (Map.fromList (map unionToEntry unions))
32+ (Map.fromList (map aliasToEntry aliases))
33+ (Map.fromList (Maybe.mapMaybe (defToEntry infixDict) defs))
32
34
33
35
34
36
35−-- CONVERSION TO DOC ENTRIES
37+-- ENTRY
36
38
37
39
38−defToEntry
40+type Entry a =
39− :: Map.Map Text (Text, Int)
41+ (Text, Docs.Raw a)
40− -> A.Commented Canonical.Def
41− -> Maybe (Text, A.Located Docs.RawValue)
42−defToEntry infixDict (A.A (_, maybeComment) (Canonical.Def _ pattern _ maybeType)) =
43− case pattern of
44− A.A subregion (Pattern.Var name) ->
45− let
46− value =
47− Docs.Value
48− maybeComment
49− (fmap (Extract.extract . A.drop) maybeType)
50− (Map.lookup name infixDict)
51− in
52− Just (name, A.A subregion value)
53
42
54− _ ->
55− Nothing
56
43
44+makeEntry :: Text -> (R.Region, Maybe Text) -> details -> Entry details
45+makeEntry name (region, maybeComment) details =
46+ ( name, A.A region (Docs.Entry maybeComment details) )
47+
48+
49+
50+-- UNIONS
57
51
58−unionToEntry :: A.Commented (D.Union Type.Canonical) -> (Text, A.Located Docs.RawUnion)
59−unionToEntry (A.A (region, maybeComment) (D.Type name args ctors)) =
60− let
61− ctors' =
62− map (second (map Extract.extract)) ctors
63− in
64− (name, A.A region (Docs.Union maybeComment args ctors'))
65
52
53+unionToEntry :: A.Commented (Decl.Union Type.Canonical) -> Entry Docs.Union
54+unionToEntry (A.A ann (Decl.Type name args ctors)) =
55+ makeEntry name ann $ Docs.Union args $
56+ map (second (map Extract.extract)) ctors
66
57
67−aliasToEntry :: A.Commented (D.Alias Type.Canonical) -> (Text, A.Located Docs.RawAlias)
68−aliasToEntry (A.A (region, maybeComment) (D.Type name args tipe)) =
69− ( name
70− , A.A region (Docs.Alias maybeComment args (Extract.extract tipe))
71− )
72
58
73
59
74−infixToEntry :: D.Infix -> (Text, (Text, Int))
60+-- ALIASES
75−infixToEntry (D.Infix name assoc precedence) =
61+
62+
63+aliasToEntry :: A.Commented (Decl.Alias Type.Canonical) -> Entry Docs.Alias
64+aliasToEntry (A.A ann (Decl.Type name args tipe)) =
65+ makeEntry name ann $ Docs.Alias args $ Extract.extract tipe
66+
67+
68+
69+-- VALUES
70+
71+
72+defToEntry :: Map.Map Text (Decl.Assoc, Int) -> A.Commented Canonical.Def -> Maybe (Entry Docs.RawValue)
73+defToEntry infixDict (A.A (_, maybeComment) definition) =
76 let
74 let
77− fixity =
75+ (Canonical.Def _ (A.A region pattern) _ maybeType) =
78− (D.assocToText assoc, precedence)
76+ definition
77+
78+ tipe =
79+ fmap (Extract.extract . A.drop) maybeType
79 in
80 in
80− ( name, fixity )
81+ case pattern of
82+ Pattern.Var name ->
83+ Just $ makeEntry name (region, maybeComment) $
84+ case Map.lookup name infixDict of
85+ Just (assoc, prec) ->
86+ Docs.Infix tipe assoc prec
87+
88+ Nothing ->
89+ if Help.isOp name then
90+ Docs.Infix tipe Decl.defaultAssociativity Decl.defaultPrecedence
91+ else
92+ Docs.Value tipe
93+
94+ _ ->
95+ Nothing
96+
97+
98+toInfixPair :: Decl.Infix -> ( Text, (Decl.Assoc, Int) )
99+toInfixPair (Decl.Infix name assoc precedence) =
100+ ( name, (assoc, precedence) )
src/Docs/Check.hs+47−41
@@ -42,18 +42,18 @@ check exports (A.A region maybeDocs) =
42
42
43
43
44checkHelp :: R.Region -> Exposing.Canonical -> Docs.Centralized -> R.Result () w Error.Error Docs.Checked
44checkHelp :: R.Region -> Exposing.Canonical -> Docs.Centralized -> R.Result () w Error.Error Docs.Checked
45−checkHelp region exposing (Docs.Centralized comment values aliases unions) =
45+checkHelp region exposing (Docs.Docs overview unions aliases values) =
46− do docNames <- parseNames region comment
46+ do docNames <- parseNames region overview
47
47
48 let docSet = Set.fromList (map A.drop docNames)
48 let docSet = Set.fromList (map A.drop docNames)
49 let restrict checker dict =
49 let restrict checker dict =
50− Map.traverseWithKey checker (Map.restrictKeys dict docSet)
50+ Map.traverseWithKey (checkEntry checker) (Map.restrictKeys dict docSet)
51
51
52 R.mapError Error.Docs $
52 R.mapError Error.Docs $
53− Docs.Checked comment
53+ Docs.Docs overview
54− <$> restrict checkValue values
54+ <$> restrict (checkUnion exposing) unions
55 <*> restrict checkAlias aliases
55 <*> restrict checkAlias aliases
56− <*> restrict (checkUnion exposing) unions
56+ <*> restrict checkValue values
57 <* checkCommentNames region exposing docNames
57 <* checkCommentNames region exposing docNames
58
58
59
59
@@ -121,61 +121,67 @@ checkComment region name maybeComment =
121
121
122
122
123
123
124−-- CHECK VALUE
124+-- CHECK ENTRY
125
125
126
126
127−checkValue :: Text -> A.Located Docs.RawValue -> Result w Docs.GoodValue
127+checkEntry :: (R.Region -> Text -> a -> Result w b) -> Text -> Docs.Raw a -> Result w (Docs.Good b)
128−checkValue name (A.A region (Docs.Value comment tipe assocPrec)) =
128+checkEntry checkDetails name (A.A region (Docs.Entry comment details)) =
129− Docs.Value
129+ Docs.Entry
130 <$> checkComment region name comment
130 <$> checkComment region name comment
131− <*> checkValueType region name tipe
131+ <*> checkDetails region name details
132− <*> pure assocPrec
133
132
134
133
135−checkValueType :: R.Region -> Text -> Maybe Type.Type -> Result w Type.Type
136−checkValueType region name maybeType =
137− case maybeType of
138− Just tipe ->
139− R.ok tipe
140
134
141− Nothing ->
135+-- CHECK UNION
142− R.throw region (E.NoType name)
136+
137+
138+checkUnion :: Exposing.Canonical -> R.Region -> Text -> Docs.Union -> Result w Docs.Union
139+checkUnion (Exposing.Canonical _ _ unions) _region name (Docs.Union args ctors) =
140+ let
141+ publicCtors =
142+ maybe [] id (lookup name unions)
143+
144+ isPublic (ctor, _) =
145+ ctor `elem` publicCtors
146+ in
147+ pure $ Docs.Union args (filter isPublic ctors)
143
148
144
149
145
150
146-- CHECK ALIAS
151-- CHECK ALIAS
147
152
148
153
149−checkAlias :: Text -> A.Located Docs.RawAlias -> Result w Docs.GoodAlias
154+checkAlias :: R.Region -> Text -> Docs.Alias -> Result w Docs.Alias
150−checkAlias name (A.A region (Docs.Alias comment args tipe)) =
155+checkAlias _ _ alias =
151− Docs.Alias
152− <$> checkComment region name comment
153− <*> pure args
156+ pure alias
154− <*> pure tipe
155
157
156
158
157
159
158−-- CHECK UNION
160+-- CHECK VALUE
159
161
160
162
161−checkUnion :: Exposing.Canonical -> Text -> A.Located Docs.RawUnion -> Result w Docs.GoodUnion
163+checkValue :: R.Region -> Text -> Docs.RawValue -> Result w Docs.GoodValue
162−checkUnion (Exposing.Canonical _ _ unions) name (A.A region (Docs.Union comment args ctors)) =
164+checkValue region name value =
165+ case value of
166+ Docs.Value tipe ->
163− Docs.Union
167+ Docs.Value
164− <$> checkComment region name comment
168+ <$> checkValueType region name tipe
165− <*> pure args
166− <*> checkUnionCtors (Map.fromList unions) name ctors
167
169
170+ Docs.Infix tipe assoc prec ->
171+ Docs.Infix
172+ <$> checkValueType region name tipe
173+ <*> pure assoc
174+ <*> pure prec
168
175
169−checkUnionCtors :: Map.Map Text [Text] -> Text -> [(Text, [Type.Type])] -> Result w [(Text, [Type.Type])]
170−checkUnionCtors unions name ctors =
171− let
172− publicCtors =
173− maybe [] id (Map.lookup name unions)
174
176
175− isPublic (ctor, _) =
177+checkValueType :: R.Region -> Text -> Maybe Type.Type -> Result w Type.Type
176− ctor `elem` publicCtors
178+checkValueType region name maybeType =
177− in
179+ case maybeType of
178− R.ok $ filter isPublic ctors
180+ Just tipe ->
181+ R.ok tipe
182+
183+ Nothing ->
184+ R.throw region (E.NoType name)
179
185
180
186
181
187
src/Elm/Compiler.hs+3−3
@@ -125,7 +125,7 @@ data Context =
125
125
126data Result =
126data Result =
127 Result
127 Result
128− { _docs :: Maybe Docs.Documentation
128+ { _docs :: Maybe Docs.Module
129 , _iface :: M.Interface
129 , _iface :: M.Interface
130 , _objs :: Obj.Graph
130 , _objs :: Obj.Graph
131 }
131 }
@@ -135,7 +135,7 @@ data Result =
135-- DOCUMENTATION
135-- DOCUMENTATION
136
136
137
137
138−docsGen :: Bool -> Module.Optimized -> Result.Result () w Error.Error (Maybe Docs.Documentation)
138+docsGen :: Bool -> Module.Optimized -> Result.Result () w Error.Error (Maybe Docs.Module)
139docsGen isExposed (Module.Module name info) =
139docsGen isExposed (Module.Module name info) =
140 if not isExposed then
140 if not isExposed then
141 Result.ok Nothing
141 Result.ok Nothing
@@ -143,7 +143,7 @@ docsGen isExposed (Module.Module name info) =
143 else
143 else
144 let
144 let
145 toDocs checked =
145 toDocs checked =
146− Just (Docs.fromCheckedDocs (ModuleName._module name) checked)
146+ Just (Docs.Module (ModuleName._module name) checked)
147 in
147 in
148 toDocs <$> Docs.check (Module.exports info) (Module.docs info)
148 toDocs <$> Docs.check (Module.exports info) (Module.docs info)
149
149
src/Elm/Docs.hs+119−132
@@ -1,218 +1,205 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Elm.Docs
3module Elm.Docs
4− ( Documentation(..)
4+ ( Documentation
5− , Alias(..)
5+ , Module(..)
6− , Union(..)
6+ , toDict
7− , Value(..)
8− , fromCheckedDocs
9 , decoder
7 , decoder
10 , encode
8 , encode
9+ , Docs.Docs(..)
10+ , Docs.Checked
11+ , Docs.Entry(..)
12+ , Docs.Union(..)
13+ , Docs.Alias(..)
14+ , Docs.Value(..)
11 )
15 )
12 where
16 where
13
17
18+
14import qualified Data.Map as Map
19import qualified Data.Map as Map
15import Data.Text (Text)
20import Data.Text (Text)
16
21
22+import qualified AST.Declaration as Decl
17import qualified Docs.AST as Docs
23import qualified Docs.AST as Docs
18import qualified Elm.Compiler.Module as Module
24import qualified Elm.Compiler.Module as Module
19import qualified Elm.Compiler.Type as Type
25import qualified Elm.Compiler.Type as Type
20−import qualified Elm.Compiler.Version as Version
21−import qualified Elm.Package as Pkg
22import qualified Json.Decode as Decode
26import qualified Json.Decode as Decode
23import qualified Json.Encode as Encode
27import qualified Json.Encode as Encode
24import Json.Encode ((==>))
28import Json.Encode ((==>))
25
29
26
30
27
31
28−-- DATA STRUCTURES
32+-- DOCUMENTATION
29
33
30
34
31−data Documentation =
35+type Documentation =
32− Documentation
33− { _name :: Module.Raw
36+ Map.Map Module.Raw Docs.Checked
34− , _comment :: Text
35− , _aliases :: [Alias]
36− , _types :: [Union]
37− , _values :: [Value]
38− , _version :: Maybe Pkg.Version
39− }
40
37
41
38
42−data Alias =
39+data Module =
43− Alias
40+ Module
44− { _a_name :: Text
41+ { _name :: !Module.Raw
45− , _a_comment :: Text
42+ , _docs :: !Docs.Checked
46− , _a_args :: [Text]
47− , _a_type :: Type.Type
48 }
43 }
49
44
50
45
51−data Union =
46+toDict :: [Module] -> Documentation
52− Union
47+toDict modules =
53− { _u_name :: Text
48+ Map.fromList $ map (\(Module name docs) -> (name, docs)) modules
54− , _u_comment :: Text
55− , _u_args :: [Text]
56− , _u_cases :: [(Text, [Type.Type])]
57− }
58−
59
49
60−data Value =
61− Value
62− { _v_name :: Text
63− , _v_comment :: Text
64− , _v_type :: Type.Type
65− , _v_fix :: Maybe (Text,Int)
66− }
67
50
68
51
52+-- ENCODE
69
53
70−-- FROM CHECKED DOCS
71
54
55+encode :: Module -> Encode.Value
56+encode (Module name (Docs.Docs overview unions aliases values)) =
57+ Encode.object $
58+ [ "name" ==> Module.encode name
59+ , "comment" ==> Encode.text overview
60+ , "types" ==> Encode.list encodeUnion (Map.toList unions)
61+ , "aliases" ==> Encode.list encodeAlias (Map.toList aliases)
62+ , "values" ==> Encode.list encodeValue (Map.toList values)
63+ ]
72
64
73−fromCheckedDocs :: Module.Raw -> Docs.Checked -> Documentation
74−fromCheckedDocs name (Docs.Checked comment values aliases unions) =
75− let
76− toValue (vName, Docs.Value vComment tipe fix) =
77− Value vName vComment tipe fix
78
65
79− toAlias (aName, Docs.Alias aComment args tipe) =
80− Alias aName aComment args tipe
81
66
82− toUnion (uName, Docs.Union uComment args cases) =
67+-- DECODE
83− Union uName uComment args cases
84− in
85− Documentation
86− name
87− comment
88− (map toAlias (Map.toList aliases))
89− (map toUnion (Map.toList unions))
90− (map toValue (Map.toList values))
91− (Just Version.version)
92
68
93
69
70+decoder :: Decode.Decoder Module
71+decoder =
72+ Module
73+ <$> Decode.field "name" Module.decoder
74+ <*> decodeDocs
94
75
95−-- JSON
96
76
77+decodeDocs :: Decode.Decoder Docs.Checked
78+decodeDocs =
79+ Docs.Docs
80+ <$> Decode.field "comment" Decode.text
81+ <*> Decode.field "types" (entryDictDecoder unionDecoder)
82+ <*> Decode.field "aliases" (entryDictDecoder aliasDecoder)
83+ <*> Decode.field "values" (entryDictDecoder valueDecoder)
97
84
98−encode :: Documentation -> Encode.Value
99−encode (Documentation name comment aliases types values elmVersion) =
100− Encode.object $
101− [ "name" ==> Module.encode name
102− , "comment" ==> Encode.text comment
103− , "aliases" ==> Encode.list encodeAlias aliases
104− , "types" ==> Encode.list encodeUnion types
105− , "values" ==> Encode.list encodeValue values
106− ]
107− ++
108− case elmVersion of
109− Nothing ->
110− []
111
85
112− Just version ->
86+entryDictDecoder :: Decode.Decoder a -> Decode.Decoder (Map.Map Text (Docs.Good a))
113− [ "generated-with-elm-version" ==> Pkg.encodeVersion version
87+entryDictDecoder subDecoder =
114− ]
88+ Map.fromList <$> Decode.list (entryDecoder subDecoder)
115
89
116
90
117−decoder :: Decode.Decoder Documentation
91+entryDecoder :: Decode.Decoder a -> Decode.Decoder ( Text, Docs.Good a )
118−decoder =
92+entryDecoder subDecoder =
119− Documentation
120− <$> Decode.field "name" Module.decoder
93+ Decode.map2 (,) (Decode.field "name" Decode.text) $
121− <*> Decode.field "comment" Decode.text
94+ Decode.map2 Docs.Entry (Decode.field "comment" Decode.text) $
122− <*> Decode.field "aliases" (Decode.list aliasDecoder)
95+ subDecoder
123− <*> Decode.field "types" (Decode.list unionDecoder)
124− <*> Decode.field "values" (Decode.list valueDecoder)
125− <*> Decode.maybe (Decode.field "generated-with-elm-version" Pkg.versionDecoder)
126
96
127
97
128
98
129−-- JSON for ALIAS
99+-- ENCODE UNION
130
100
131
101
132−encodeAlias :: Alias -> Encode.Value
102+encodeUnion :: ( Text, Docs.Good Docs.Union ) -> Encode.Value
133−encodeAlias (Alias name comment args tipe) =
103+encodeUnion ( name, Docs.Entry comment (Docs.Union args cases) ) =
134 Encode.object
104 Encode.object
135 [ "name" ==> Encode.text name
105 [ "name" ==> Encode.text name
136 , "comment" ==> Encode.text comment
106 , "comment" ==> Encode.text comment
137 , "args" ==> Encode.list Encode.text args
107 , "args" ==> Encode.list Encode.text args
138− , "type" ==> Type.encode tipe
108+ , "cases" ==> Encode.list encodeCase cases
139 ]
109 ]
140
110
141
111
112+encodeCase :: ( Text, [Type.Type] ) -> Encode.Value
113+encodeCase ( tag, args ) =
114+ Encode.list id [ Encode.text tag, Encode.list Type.encode args ]
115+
116+
117+
118+-- DECODE UNION
119+
120+
142−aliasDecoder :: Decode.Decoder Alias
121+unionDecoder :: Decode.Decoder Docs.Union
143−aliasDecoder =
122+unionDecoder =
144− Alias
123+ Docs.Union
145− <$> Decode.field "name" Decode.text
124+ <$> Decode.field "args" (Decode.list Decode.text)
146− <*> Decode.field "comment" Decode.text
147− <*> Decode.field "args" (Decode.list Decode.text)
125+ <*> Decode.field "cases" (Decode.list caseDecoder)
148− <*> Decode.field "type" Type.decoder
149
126
150
127
128+caseDecoder :: Decode.Decoder ( Text, [Type.Type] )
129+caseDecoder =
130+ (,)
131+ <$> Decode.index 0 Decode.text
132+ <*> Decode.index 1 (Decode.list Type.decoder)
133+
151
134
152−-- JSON for UNION
153
135
136+-- ENCODE ALIAS
154
137
155−encodeUnion :: Union -> Encode.Value
138+
156−encodeUnion (Union name comment args cases) =
139+encodeAlias :: ( Text, Docs.Good Docs.Alias ) -> Encode.Value
140+encodeAlias ( name, Docs.Entry comment (Docs.Alias args tipe) ) =
157 Encode.object
141 Encode.object
158 [ "name" ==> Encode.text name
142 [ "name" ==> Encode.text name
159 , "comment" ==> Encode.text comment
143 , "comment" ==> Encode.text comment
160 , "args" ==> Encode.list Encode.text args
144 , "args" ==> Encode.list Encode.text args
161− , "cases" ==> Encode.list encodeCase cases
145+ , "type" ==> Type.encode tipe
162 ]
146 ]
163
147
164
148
165−unionDecoder :: Decode.Decoder Union
166−unionDecoder =
167− Union
168− <$> Decode.field "name" Decode.text
169− <*> Decode.field "comment" Decode.text
170− <*> Decode.field "args" (Decode.list Decode.text)
171− <*> Decode.field "cases" (Decode.list caseDecoder)
172−
173
149
174−encodeCase :: ( Text, [Type.Type] ) -> Encode.Value
150+-- DECODE ALIAS
175−encodeCase ( tag, args ) =
176− Encode.list id [ Encode.text tag, Encode.list Type.encode args ]
177
151
178
152
179−caseDecoder :: Decode.Decoder ( Text, [Type.Type] )
153+aliasDecoder :: Decode.Decoder Docs.Alias
180−caseDecoder =
154+aliasDecoder =
181− (,)
155+ Docs.Alias
182− <$> Decode.index 0 Decode.text
156+ <$> Decode.field "args" (Decode.list Decode.text)
183− <*> Decode.index 1 (Decode.list Type.decoder)
157+ <*> Decode.field "type" Type.decoder
184
158
185
159
186
160
187−-- JSON for VALUE
161+-- ENCODE VALUE
188
162
189
163
190−encodeValue :: Value -> Encode.Value
164+encodeValue :: ( Text, Docs.Good Docs.GoodValue ) -> Encode.Value
191−encodeValue (Value name comment tipe assocPrec) =
165+encodeValue ( name, Docs.Entry comment value ) =
192 Encode.object $
166 Encode.object $
193 [ "name" ==> Encode.text name
167 [ "name" ==> Encode.text name
194 , "comment" ==> Encode.text comment
168 , "comment" ==> Encode.text comment
195− , "type" ==> Type.encode tipe
196 ]
169 ]
197 ++
170 ++
198− case assocPrec of
171+ case value of
199− Nothing ->
172+ Docs.Value tipe ->
173+ [ "type" ==> Type.encode tipe
200− []
174+ ]
201
175
202− Just (assoc, prec) ->
176+ Docs.Infix tipe assoc prec ->
177+ [ "type" ==> Type.encode tipe
203− [ "associativity" ==> Encode.text assoc
178+ , "associativity" ==> Encode.text (Decl.assocToText assoc)
204 , "precedence" ==> Encode.int prec
179 , "precedence" ==> Encode.int prec
205 ]
180 ]
206
181
207
182
183+
184+-- DECODE VALUE
185+
186+
208−valueDecoder :: Decode.Decoder Value
187+valueDecoder :: Decode.Decoder Docs.GoodValue
209valueDecoder =
188valueDecoder =
210− Value
211− <$> Decode.field "name" Decode.text
212− <*> Decode.field "comment" Decode.text
213− <*> Decode.field "type" Type.decoder
189+ do tipe <- Decode.field "type" Type.decoder
214− <*> Decode.maybe (
190+ Decode.oneOf
215− (,)
191+ [ Docs.Infix tipe
216− <$> Decode.field "associativity" Decode.text
192+ <$> Decode.field "associativity" assocDecoder
217− <*> Decode.field "precedence" Decode.int
193+ <*> Decode.field "precedence" Decode.int
218− )
194+ , Decode.succeed (Docs.Value tipe)
195+ ]
196+
197+
198+assocDecoder :: Decode.Decoder Decl.Assoc
199+assocDecoder =
200+ do txt <- Decode.text
201+ case txt of
202+ "left" -> Decode.succeed Decl.Left
203+ "non" -> Decode.succeed Decl.Non
204+ "right" -> Decode.succeed Decl.Right
205+ _ -> Decode.fail "an associativity"
src/Parse/Declaration.hs+3−3
@@ -117,11 +117,11 @@ infixDecl :: R.Position -> SParser Decl.Source
117infixDecl start =
117infixDecl start =
118 oneOf
118 oneOf
119 [ do keyword "infixl"
119 [ do keyword "infixl"
120− inContext start E.Infix $ infixDeclHelp start Decl.L
120+ inContext start E.Infix $ infixDeclHelp start Decl.Left
121 , do keyword "infixr"
121 , do keyword "infixr"
122− inContext start E.Infix $ infixDeclHelp start Decl.R
122+ inContext start E.Infix $ infixDeclHelp start Decl.Right
123 , do keyword "infix"
123 , do keyword "infix"
124− inContext start E.Infix $ infixDeclHelp start Decl.N
124+ inContext start E.Infix $ infixDeclHelp start Decl.Non
125 ]
125 ]
126
126
127
127