Various fixes
This commit is contained in:
parent
f84f91327c
commit
0c1e79f1fc
|
@ -42,6 +42,8 @@ graph b = span $ Graph.graphFromEdges $ go <$> toList ys
|
|||
go (x, xs) = (x, prettyContext x, prettyContext <$> toList xs)
|
||||
Result ys = references b
|
||||
|
||||
-- The elements appear in reverse order. I expect this to cause all
|
||||
-- sorts of issues.
|
||||
newtype Namespace = Namespace [Text]
|
||||
deriving stock instance Show Namespace
|
||||
deriving stock instance Eq Namespace
|
||||
|
@ -53,13 +55,11 @@ instance IsList Namespace where
|
|||
deriving newtype instance Semigroup Namespace
|
||||
deriving newtype instance Monoid Namespace
|
||||
instance FromJSON Namespace where
|
||||
parseJSON = Aeson.withText "Namespace" $ \t -> Namespace <$> (traverse pure $ Text.splitOn "::" t)
|
||||
parseJSON = Aeson.withText "Namespace"
|
||||
$ \t -> Namespace <$> (traverse pure $ reverse $ Text.splitOn "::" t)
|
||||
instance ToJSON Namespace where
|
||||
toJSON = Aeson.String . showNamespace
|
||||
|
||||
showNamespace :: Namespace -> Text
|
||||
showNamespace = Text.intercalate "::" . coerce
|
||||
|
||||
-- Names are in reverse order.
|
||||
data FQN = FQN
|
||||
{ namespace :: Namespace
|
||||
|
@ -79,6 +79,8 @@ instance FromJSON Node where
|
|||
nodeParser :: Text -> Aeson.Parser Node
|
||||
nodeParser = \t -> case Text.splitOn "." t of
|
||||
[mods,fun] -> fmap NodeDef (FQN <$> Aeson.parseJSON (Aeson.String mods) <*> pure fun)
|
||||
-- The top-level
|
||||
[[]] -> pure $ NodeModule mempty
|
||||
[mods] ->
|
||||
if beginsWithCapital mods
|
||||
then NodeModule <$> Aeson.parseJSON (Aeson.String mods)
|
||||
|
@ -112,6 +114,14 @@ prettyFQN FQN{name, namespace} = case namespace of
|
|||
[] -> name
|
||||
_ -> convertString (showNamespace namespace) <> "." <> name
|
||||
|
||||
prettyContext :: Node -> Text
|
||||
prettyContext = \case
|
||||
NodeDef fun -> prettyFQN fun
|
||||
NodeModule ns -> showNamespace ns
|
||||
|
||||
showNamespace :: Namespace -> Text
|
||||
showNamespace = Text.intercalate "::" . reverse . coerce
|
||||
|
||||
newtype Context = Context Node
|
||||
|
||||
deriving stock instance Eq Context
|
||||
|
@ -119,9 +129,12 @@ deriving stock instance Ord Context
|
|||
deriving newtype instance ToJSON Context
|
||||
-- HACK: Not really a semigroup as is evident from the implementation.
|
||||
instance Semigroup Context where
|
||||
Context c0 <> Context c1 = case (c0, c1) of
|
||||
(NodeModule n0, NodeModule n1) -> Context $ NodeModule $ n0 <> n1
|
||||
(NodeModule n0, NodeDef (FQN n1 f)) -> Context $ NodeDef $ FQN (n0 <> n1) f
|
||||
-- I think that the order must be swapped because they modules are in reverse order.
|
||||
Context c0 <> Context c1 = case traceShowId (c0, c1) of
|
||||
-- (NodeModule n0, NodeModule n1) -> Context $ NodeModule $ n0 <> n1
|
||||
(NodeModule n0, NodeModule n1) -> Context $ NodeModule $ n1 <> n0
|
||||
-- (NodeModule n0, NodeDef (FQN n1 f)) -> Context $ NodeDef $ FQN (n0 <> n1) f
|
||||
(NodeModule n0, NodeDef (FQN n1 f)) -> Context $ NodeDef $ FQN (n1 <> n0) f
|
||||
(NodeDef{}, NodeModule{}) -> error "Cannot append module to function context."
|
||||
(NodeDef{}, NodeDef{}) -> error "Cannot append function to function context."
|
||||
|
||||
|
@ -145,11 +158,6 @@ instance ToJSON Result where
|
|||
where
|
||||
go :: (Node, Set Node) -> (Text, Aeson.Value)
|
||||
go (x, y) = (prettyContext x, Aeson.toJSON y)
|
||||
|
||||
prettyContext :: Node -> Text
|
||||
prettyContext = \case
|
||||
NodeDef fun -> prettyFQN fun
|
||||
NodeModule ns -> showNamespace ns
|
||||
|
||||
instance MyMonad (State Env) where
|
||||
declaration q = modify go
|
||||
|
@ -290,8 +298,8 @@ instance References Ruby.Def where
|
|||
|
||||
instance References Ruby.Defs where
|
||||
-- TODO: The field `context` is also relevant here!
|
||||
entries Ruby.Defs{atom, begin}
|
||||
= entries $ Ruby.Def{atom,begin,args=error "hack"}
|
||||
entries Ruby.Defs{atom, begin, args}
|
||||
= entries $ Ruby.Def{atom,begin,args}
|
||||
|
||||
qual :: Namespace -> Ruby.Atom -> FQN
|
||||
qual namespace (Ruby.Atom name) = FQN { namespace , name }
|
||||
|
|
Loading…
Reference in a new issue