diff --git a/src/Rubyhs/References.hs b/src/Rubyhs/References.hs index 24aa28a..f618b4c 100644 --- a/src/Rubyhs/References.hs +++ b/src/Rubyhs/References.hs @@ -20,7 +20,6 @@ import Data.Kind import Control.Monad.State import Data.Aeson ((.=)) import qualified Data.Aeson as Aeson -import Data.List import Data.HashMap.Strict (HashMap) import Data.Set (Set) import qualified Data.Set as Set @@ -38,12 +37,15 @@ deriving stock instance Eq Namespace deriving stock instance Ord Namespace instance IsList Namespace where type Item Namespace = Text - fromList = Namespace . fromList - toList (Namespace l) = toList l + fromList = coerce + toList = coerce deriving newtype instance Semigroup Namespace deriving newtype instance Monoid Namespace instance ToJSON Namespace where - toJSON = Aeson.String . Text.intercalate "::" . coerce + toJSON = Aeson.String . showNamespace + +showNamespace :: Namespace -> Text +showNamespace = Text.intercalate "::" . coerce -- Names are in reverse order. data FQN = FQN @@ -66,7 +68,7 @@ deriving stock instance Show FQN deriving stock instance Eq FQN deriving stock instance Ord FQN instance Pretty Namespace where - pretty = pretty . prettyNamespace + pretty = pretty . showNamespace instance Aeson.ToJSON FQN where toJSON = Aeson.String . prettyFQN @@ -77,10 +79,7 @@ instance Pretty FQN where prettyFQN :: FQN -> Text prettyFQN FQN{name, namespace} = case namespace of [] -> name - _ -> prettyNamespace namespace <> "." <> name - -prettyNamespace :: Namespace -> Text -prettyNamespace = convertString . intercalate "::" . fmap convertString . reverse . toList + _ -> convertString (showNamespace namespace) <> "." <> name newtype Context = Context Node @@ -119,7 +118,7 @@ instance ToJSON Result where prettyContext :: Node -> Text prettyContext = \case NodeFunction fun -> prettyFQN fun - NodeModule ns -> prettyNamespace ns + NodeModule ns -> showNamespace ns instance MyMonad (State Env) where declaration q = modify go @@ -188,7 +187,13 @@ instance References Ruby.Namespace where entries = \case Ruby.Namespace xs -> do Context c <- getContext - application c (NodeModule (Namespace ((\(Name (Aeson.String t)) -> t) <$> xs))) + let + ctxt = case c of + NodeFunction FQN{namespace} -> namespace + NodeModule namespace -> namespace + -- TODO Hacky: + ns = Namespace ((\(Name (Aeson.String t)) -> t) <$> xs) + application c (NodeModule $ ctxt `onTop` ns) instance References Module where entries Module{name, block} = do @@ -214,10 +219,25 @@ qual namespace (Name o) = case o of Aeson.String name -> FQN { namespace , name } _ -> error $ show o + +onTop' :: Eq a => [a] -> [a] -> [a] +onTop' [] y = y +onTop' x [] = x +onTop' (x:xss) ys@(y:yss) = if + | x == y -> pure x <> yss + | otherwise -> pure x <> xss `onTop'` ys + +onTop :: Namespace -> Namespace -> Namespace +onTop (Namespace xs) (Namespace ys) = Namespace $ reverse $ reverse xs `onTop'` reverse ys + instance References Send where entries Send{namespace, name} = do Context c <- getContext - application c $ NodeFunction $ qual (fromNS namespace) name + let + ctxt = case c of + NodeFunction FQN{namespace = ns} -> ns + NodeModule ns -> ns + application c $ NodeFunction $ qual (ctxt `onTop` fromNS namespace) name where fromNS :: Ruby.Namespace -> Namespace fromNS (Ruby.Namespace l) = Namespace $ go <$> l