stuff

ruby/test.rb

@@ -10,7 +10,13 @@ module M
 
   module N
     def f
-      g
+      M::foo
+      h
+    end
+
+    module A::B
+      def k
+      end
     end
 
     def g

src/Data/Language/Ruby.hs

@@ -8,6 +8,7 @@ module Data.Language.Ruby
   , Module(..)
   , Name(..)
   , Send(..)
+  , Namespace(..)
   ) where
 
 import Data.Aeson (parseJSON, Value(..), withArray)
@@ -65,8 +66,26 @@ instance FromJSON Definition where
     <|> (DefFunction <$> parseJSON val)
     <|> (DefSend <$> parseJSON val)
 
+newtype Namespace = Namespace [Name]
+
+deriving newtype instance Semigroup Namespace
+deriving newtype instance Monoid Namespace
+deriving stock instance Show Namespace
+deriving stock instance Ord Namespace
+deriving stock instance Eq Namespace
+deriving stock instance Generic Namespace
+instance ToJSON Namespace where
+  toEncoding = Aeson.genericToEncoding aesonOptions
+
+instance FromJSON Namespace where
+  parseJSON = \case
+    Null -> pure mempty
+    Array [String "const", namespace, String name] -> (<> Namespace [Name $ String name]) <$> parseJSON namespace
+    x -> error $ show x
+
 data Send = Send
   { args :: Args
+  , namespace :: Namespace
   , name :: Name
   }
 
@@ -79,9 +98,10 @@ instance ToJSON Send where
 
 instance FromJSON Send where
   parseJSON = withArray "Send" $ \ as -> case Vector.toList as of
-    (String "send" : _ : name : args)
+    (String "send" : namespace : name : args)
       ->  Send
       <$> parseJSON (Array $ Vector.fromList args)
+      <*> parseJSON namespace
       <*> parseJSON name
     _ -> empty
 

src/Rubyhs.hs

@@ -20,6 +20,7 @@ run :: FilePath -> IO ()
 run p = do
   json <- runParser p
   block <- decodeFail @_ @Block $ ByteString.pack json
+  -- ByteString.putStrLn $ encode block
   ByteString.putStrLn $ encode $ references block
 
 decodeFail :: MonadFail m => FromJSON a => ByteString -> m a

src/Rubyhs/References.hs

@@ -7,10 +7,12 @@ module Rubyhs.References
   , references
   , Env(..)
   , Result(..)
+  , Namespace(..)
   ) where
 
 import Frelude
-import Data.Language.Ruby
+import Data.Language.Ruby hiding (Namespace)
+import qualified Data.Language.Ruby as Ruby
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Kind
@@ -21,59 +23,74 @@ import Data.List
 import Data.HashMap.Strict (HashMap)
 import Data.Text.Prettyprint.Doc.Render.Text (renderStrict)
 import Data.Text.Prettyprint.Doc (layoutCompact)
+import Data.Set (Set)
+import qualified Data.Set as Set
 
 data Entry a = Entry
   { node :: a
   , fqn :: FQN
   }
 
+newtype Namespace = Namespace [Text]
+deriving stock instance Show Namespace
+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
+deriving newtype instance Semigroup Namespace
+deriving newtype instance Monoid Namespace
+
 -- Names are in reverse order.
-newtype FQN = FQN ([] Name)
+data FQN = FQN
+  { namespace :: Namespace
+  , name :: Text
+  }
 
 deriving stock instance Show FQN
-deriving newtype instance Semigroup FQN
-instance Monoid FQN where
-  -- mempty is the top level.
-  mempty = FQN mempty
-deriving newtype instance Aeson.ToJSON FQN
-instance Aeson.ToJSONKey FQN where
-instance IsList FQN where
-  type Item FQN = Name
-  fromList l = FQN $ fromList l
-  toList (FQN l) = toList l
-instance Pretty FQN where
-  pretty = pretty . intercalate "::" . fmap go . reverse . toList
-    where
-    go (Name (Aeson.Array [_, _, Aeson.String n])) = convertString n
-    go x = show x
+deriving stock instance Eq FQN
+deriving stock instance Ord FQN
+instance Pretty Namespace where
+  pretty = pretty . prettyNamespace
 
-deriving newtype instance Eq FQN
-deriving newtype instance Ord FQN
+instance Aeson.ToJSON FQN where
+  toJSON = Aeson.String . prettyFQN
+instance Aeson.ToJSONKey FQN where
+instance Pretty FQN where
+  pretty = pretty . prettyFQN
+
+prettyFQN :: FQN -> Text
+prettyFQN FQN{namespace, name} = case namespace of
+  [] -> name
+  _ -> prettyNamespace namespace <> "." <> name
+
+prettyNamespace :: Namespace -> Text
+prettyNamespace = convertString . intercalate "::" . fmap convertString . reverse . toList
 
 class Monad m => MyMonad (m :: Type -> Type) where
-  declaration :: FQN -> Name -> m ()
-  application :: FQN -> Name -> m ()
-  getContext :: m FQN
-  writeContext :: FQN -> m ()
+  declaration :: FQN -> m ()
+  application :: Namespace -> FQN -> m ()
+  getContext :: m Namespace
+  writeContext :: Namespace -> m ()
 
 data Env = Env
-  { declarations :: Map FQN [Name]
-  , applications :: Map FQN [Name]
-  , context      :: FQN
+  { declarations :: Set FQN
+  , applications :: Map Namespace (Set FQN)
+  , context      :: Namespace
   }
 
 data Result = Result
-  { declarations :: Map FQN [Name]
-  , applications :: Map FQN [Name]
+  { declarations :: Set FQN
+  , applications :: Map Namespace (Set FQN)
   }
 instance ToJSON Result where
   toJSON Result{declarations,applications} = Aeson.object
-    [ "declarations" .= f declarations
+    [ "declarations" .= declarations
     , "applications" .= f applications
     ]
     where
-      f :: Map FQN [Name] -> HashMap Text [Name]
-      f x = fromList $ go <$> toList x
+      f x = fromList @(HashMap _ _) $ go <$> toList x
       go (x, y) = (renderStrict $ layoutCompact $ pretty x, y)
 
 instance Semigroup Env where
@@ -83,20 +100,20 @@ instance Monoid Env where
   mempty = Env mempty mempty mempty
   
 instance MyMonad (State Env) where
-  declaration q n = modify go
+  declaration q = modify go
     where
     go :: Env -> Env
-    go env@Env{declarations} = env { declarations = Map.insertWith mappend q (pure n) declarations }
+    go env@Env{declarations} = env { declarations = Set.insert q declarations }
   application q n = modify go
     where
     go :: Env -> Env
-    go env@Env{applications} = env { applications = Map.insertWith mappend q (pure n) applications }
+    go env@Env{applications} = env { applications = Map.insertWith mappend q (Set.singleton n) applications }
   getContext = gets context
   writeContext q = modify go
     where
     go env = env { context = q }
 
-updateContext :: MyMonad m => (FQN -> FQN) -> m ()
+updateContext :: MyMonad m => (Namespace -> Namespace) -> m ()
 updateContext f = getContext >>= \c -> writeContext (f c)
 
 locally :: MyMonad m => m a -> m a
@@ -109,7 +126,12 @@ locally act = do
 appendToContext :: MyMonad m => Name -> m ()
 appendToContext n = updateContext go
   where
-  go (FQN ns) = FQN $ pure n <> ns
+  go q = name2ns n <> q
+
+name2ns :: Name -> Namespace
+name2ns (Name o) = case o of
+  Aeson.Array [_, _, Aeson.String s] -> [s]
+  _ -> error $ show o
 
 class References a where
   entries :: MyMonad m => a -> m ()
@@ -136,11 +158,23 @@ instance References Module where
 
 instance References Function where
   entries Function{name, block} = do
-    c <- getContext
-    declaration c name
+    namespace <- getContext
+    declaration $ qual namespace name
     entries block
 
+qual :: Namespace -> Name -> FQN
+qual namespace (Name o) = case o of
+  Aeson.String name -> FQN { namespace , name }
+  _ -> error $ show o
+
 instance References Send where
-  entries Send{name} = do
+  entries Send{namespace, name} = do
     c <- getContext
-    application c name
+    application c $ qual (fromNS namespace) name
+    where
+    fromNS :: Ruby.Namespace -> Namespace
+    fromNS (Ruby.Namespace l) = Namespace $ go <$> l
+    go :: Name -> Text
+    go (Name o) = case o of
+      Aeson.String s -> s
+      _ -> error $ show o