git.iko.soy/elk
on c19392f help sign in
elk/src/Docs/Centralize.hs
100 lines 2.5 kB history raw
1module Docs.Centralize (centralize) where
3import Control.Arrow (second)
4import qualified Data.Map as Map
5import qualified Data.Maybe as Maybe
6import Data.Text (Text)
8import qualified AST.Declaration as Decl
9import qualified AST.Expression.Canonical as Canonical
10import qualified AST.Helpers as Help
11import qualified AST.Pattern as Pattern
12import qualified AST.Type as Type
13import qualified Docs.AST as Docs
14import qualified Elm.Compiler.Type.Extract as Extract
15import qualified Reporting.Annotation as A
16import qualified Reporting.Region as R
20-- CENTRALIZE
23centralize :: Decl.Canonical -> Text -> Docs.Centralized
24centralize (Decl.Decls defs unions aliases infixes) overview =
25 let
26 infixDict =
27 Map.fromList (map toInfixPair infixes)
28 in
29 Docs.Docs
30 overview
31 (Map.fromList (map unionToEntry unions))
32 (Map.fromList (map aliasToEntry aliases))
33 (Map.fromList (Maybe.mapMaybe (defToEntry infixDict) defs))
37-- ENTRY
40type Entry a =
41 (Text, Docs.Raw a)
44makeEntry :: Text -> (R.Region, Maybe Text) -> details -> Entry details
45makeEntry name (region, maybeComment) details =
46 ( name, A.A region (Docs.Entry maybeComment details) )
50-- UNIONS
53unionToEntry :: A.Commented (Decl.Union Type.Canonical) -> Entry Docs.Union
54unionToEntry (A.A ann (Decl.Type name args ctors)) =
55 makeEntry name ann $ Docs.Union args $
56 map (second (map Extract.extract)) ctors
60-- ALIASES
63aliasToEntry :: A.Commented (Decl.Alias Type.Canonical) -> Entry Docs.Alias
64aliasToEntry (A.A ann (Decl.Type name args tipe)) =
65 makeEntry name ann $ Docs.Alias args $ Extract.extract tipe
69-- VALUES
72defToEntry :: Map.Map Text (Decl.Assoc, Int) -> A.Commented Canonical.Def -> Maybe (Entry Docs.RawValue)
73defToEntry infixDict (A.A (_, maybeComment) definition) =
74 let
75 (Canonical.Def _ (A.A region pattern) _ maybeType) =
76 definition
78 tipe =
79 fmap (Extract.extract . A.drop) maybeType
80 in
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
88 Nothing ->
89 if Help.isOp name then
90 Docs.Infix tipe Decl.defaultAssociativity Decl.defaultPrecedence
91 else
92 Docs.Value tipe
94 _ ->
95 Nothing
98toInfixPair :: Decl.Infix -> ( Text, (Decl.Assoc, Int) )
99toInfixPair (Decl.Infix name assoc precedence) =
100 ( name, (assoc, precedence) )