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