Also handle constants

package.yaml

@@ -33,6 +33,7 @@ dependencies:
   - unordered-containers
   - optparse-applicative
   - temporary
+  - text
 
 default-extensions:
   - ConstraintKinds

src/Data/Language/Ruby.hs

@@ -49,6 +49,9 @@ data Statement
   | StmtFunction Function
   | StmtSend Send
   | StmtRBlock RBlock
+  -- TODO: We should also handle modules here.  Otherwise we cannot
+  -- cover the case where a function references a module.
+  | StmtConst Namespace
   | StmtAnything Anything
 
 deriving stock instance Show Statement
@@ -64,6 +67,7 @@ instance ToJSON Statement where
       "StmtFunction" -> "function"
       "StmtSend"     -> "send"
       "StmtRBlock"   -> "block"
+      "StmtConst"    -> "const"
       x             -> x
 
 instance FromJSON Statement where
@@ -72,6 +76,7 @@ instance FromJSON Statement where
     <|> (StmtFunction <$> parseJSON v)
     <|> (StmtSend     <$> parseJSON v)
     <|> (StmtRBlock   <$> parseJSON v)
+    <|> (StmtConst    <$> parseJSON v)
     <|> (StmtAnything <$> parseJSON v)
 
 newtype Anything = Anything Value

src/Rubyhs/References.hs

@@ -24,6 +24,8 @@ import Data.List
 import Data.HashMap.Strict (HashMap)
 import Data.Set (Set)
 import qualified Data.Set as Set
+import qualified Data.Text as Text
+import Data.Coerce
 
 data Entry a = Entry
   { node :: a
@@ -40,6 +42,8 @@ instance IsList Namespace where
   toList (Namespace l) = toList l
 deriving newtype instance Semigroup Namespace
 deriving newtype instance Monoid Namespace
+instance ToJSON Namespace where
+  toJSON = Aeson.String . Text.intercalate "::" . coerce
 
 -- Names are in reverse order.
 data FQN = FQN
@@ -47,6 +51,17 @@ data FQN = FQN
   , name :: Text
   }
 
+data Node = NodeFunction FQN | NodeModule Namespace
+
+deriving stock instance Show Node
+deriving stock instance Eq Node
+deriving stock instance Ord Node
+
+instance ToJSON Node where
+  toJSON = \case
+    NodeFunction q -> Aeson.toJSON q
+    NodeModule m -> Aeson.toJSON m
+
 deriving stock instance Show FQN
 deriving stock instance Eq FQN
 deriving stock instance Ord FQN
@@ -60,47 +75,51 @@ instance Pretty FQN where
   pretty = pretty . prettyFQN
 
 prettyFQN :: FQN -> Text
-prettyFQN FQN{namespace, name} = case namespace of
+prettyFQN FQN{name, namespace} = case namespace of
   [] -> name
   _ -> prettyNamespace namespace <> "." <> name
 
 prettyNamespace :: Namespace -> Text
 prettyNamespace = convertString . intercalate "::" . fmap convertString . reverse . toList
 
-data Context = ContextFun FQN | ContextMod Namespace
+newtype Context = Context Node
 
 deriving stock instance Eq Context
 deriving stock instance Ord Context
+deriving newtype instance ToJSON Context
 
 class Monad m => MyMonad (m :: Type -> Type) where
-  declaration :: FQN -> m ()
+  declaration :: Node -> m ()
-  application :: Context -> FQN -> m ()
+  application :: Node -> Node -> m ()
   getContext :: m Context
   writeContext :: Context -> m ()
 
 data Env = Env
-  { declarations :: Set FQN
+  { declarations :: Set Node
-  , applications :: Map Context (Set FQN)
+  , applications :: Map Node (Set Node)
   , context      :: Context
   }
 
 data Result = Result
-  { declarations :: Set FQN
+  { declarations :: Set Node
-  , applications :: Map Context (Set FQN)
+  , applications :: Map Node (Set Node)
   }
 instance ToJSON Result where
   toJSON Result{declarations,applications} = Aeson.object
     [ "declarations" .= declarations
-    , "applications" .= f applications
+    , "applications" .= f
     ]
     where
-      f x = fromList @(HashMap _ _) $ go <$> toList x
+    f :: HashMap Text (Set Node)
+    f = fromList @(HashMap _ _) $ go <$> toList applications
+    -- go :: (Node, Set Node) -> (Text, Set Node)
+    go :: (Node, Set Node) -> (Text, Set Node)
     go (x, y) = (prettyContext x, y)
 
-prettyContext :: Context -> Text
+prettyContext :: Node -> Text
 prettyContext = \case
-  ContextFun q -> prettyFQN q
+  NodeFunction fun -> prettyFQN fun
-  ContextMod ns -> prettyNamespace ns
+  NodeModule ns -> prettyNamespace ns
   
 instance MyMonad (State Env) where
   declaration q = modify go
@@ -129,8 +148,8 @@ locally act = do
 appendToContext :: MyMonad m => Name -> m ()
 appendToContext n = updateContext go
   where
-  go (ContextMod q) = ContextMod $ name2ns n <> q
+  go (Context (NodeModule q)) = Context $ NodeModule $ name2ns n <> q
-  go _ = error "Cannot append module to context in function context"
+  go (Context NodeFunction{}) = error "Cannot append module to context in function context"
 
 name2ns :: Name -> Namespace
 name2ns (Name o) = go o
@@ -149,7 +168,7 @@ references :: Block -> Result
 references q = Result{declarations, applications}
   where
   Env{declarations,applications} = execState (entries @_ @(State Env) q) emptyEnv
-  emptyEnv = Env mempty mempty (ContextMod mempty)
+  emptyEnv = Env mempty mempty (Context $ NodeModule mempty)
 
 instance References Block where
   entries :: forall m . MyMonad m => Block -> m ()
@@ -160,23 +179,34 @@ instance References Statement where
     StmtModule m   -> entries m
     StmtFunction f -> entries f
     StmtSend s     -> entries s
+    StmtConst c    -> entries c
     -- TODO:
     StmtRBlock{}   -> pure ()
     StmtAnything{} -> pure ()
 
+instance References Ruby.Namespace where
+  entries = \case
+    Ruby.Namespace xs -> do
+      Context c <- getContext
+      application c (NodeModule (Namespace ((\(Name (Aeson.String t)) -> t) <$> xs)))
+
 instance References Module where
   entries Module{name, block} = do
     appendToContext name
+    c <- getContext >>= \case
+      Context (NodeModule c) -> pure c
+      _ -> error "..."
+    declaration $ NodeModule c
     entries block
 
 instance References Function where
   entries Function{name, block} = do
     namespace <- getContext >>= \case
-      ContextMod c -> pure c
+      Context (NodeModule c) -> pure c
-      _ -> error "Cannot have a function declaration in a function context"
+      Context NodeFunction{} -> error "Cannot have a function declaration in a function context"
-    declaration $ qual namespace name
+    declaration $ NodeFunction $ qual namespace name
     locally $ do
-      writeContext (ContextFun $ qual namespace name)
+      writeContext (Context $ NodeFunction $ qual namespace name)
       entries block
 
 qual :: Namespace -> Name -> FQN
@@ -186,8 +216,8 @@ qual namespace (Name o) = case o of
 
 instance References Send where
   entries Send{namespace, name} = do
-    c <- getContext
+    Context c <- getContext
-    application c $ qual (fromNS namespace) name
+    application c $ NodeFunction $ qual (fromNS namespace) name
     where
     fromNS :: Ruby.Namespace -> Namespace
     fromNS (Ruby.Namespace l) = Namespace $ go <$> l