git.iko.soy/elk
on 267f708 help sign in
elk/src/Docs/Centralize.hs
80 lines 2.2 kB history raw
1module Docs.Centralize (centralize) where
3import Control.Arrow (second)
4import qualified Data.Map as Map
5import qualified Data.Maybe as Maybe
7import qualified AST.Declaration as D
8import qualified AST.Expression.Canonical as Canonical
9import qualified AST.Pattern as Pattern
10import qualified AST.Type as Type
11import qualified Docs.AST as Docs
12import qualified Elm.Compiler.Type as Type
13import qualified Elm.Compiler.Type.Extract as Extract
14import qualified Reporting.Annotation as A
18-- CENTRALIZE DOCUMENTATION
21centralize :: D.Canonical -> String -> Docs.Centralized
22centralize (D.Decls defs unions aliases infixes) comment =
23 let
24 infixDict =
25 Map.fromList (map infixToEntry infixes)
26 in
27 Docs.Docs
28 comment
29 (Map.fromList (map aliasToEntry aliases))
30 (Map.fromList (map unionToEntry unions))
31 (Map.fromList (Maybe.mapMaybe (defToEntry infixDict) defs))
35-- CONVERSION TO DOC ENTRIES
38defToEntry
39 :: Map.Map String (String, Int)
40 -> A.Commented Canonical.Def
41 -> Maybe (String, A.Located (Docs.Value (Maybe Type.Type)))
42defToEntry 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.toAliasedType . A.drop) maybeType)
50 (Map.lookup name infixDict)
51 in
52 Just (name, A.A subregion value)
54 _ ->
55 Nothing
58unionToEntry :: A.Commented (D.Union Type.Canonical) -> (String, A.Located Docs.Union)
59unionToEntry (A.A (region, maybeComment) (D.Type name args ctors)) =
60 let
61 ctors' =
62 map (second (map Extract.toAliasedType)) ctors
63 in
64 (name, A.A region (Docs.Union maybeComment args ctors'))
67aliasToEntry :: A.Commented (D.Alias Type.Canonical) -> (String, A.Located Docs.Alias)
68aliasToEntry (A.A (region, maybeComment) (D.Type name args tipe)) =
69 ( name
70 , A.A region (Docs.Alias maybeComment args (Extract.toAliasedType tipe))
71 )
74infixToEntry :: D.Infix -> (String, (String, Int))
75infixToEntry (D.Infix name assoc precedence) =
76 let
77 fixity =
78 (D.assocToString assoc, precedence)
79 in
80 ( name, fixity )