Various fixes

This commit is contained in:
Frederik Hanghøj Iversen 2019-10-20 22:43:48 +02:00
parent f84f91327c
commit 0c1e79f1fc
1 changed files with 22 additions and 14 deletions

View File

@ -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 }