Simplify application a bit

This commit is contained in:
Frederik Hanghøj Iversen 2019-10-16 22:43:19 +02:00
parent 4463077e55
commit 6b3eaeb737

View file

@ -104,7 +104,7 @@ deriving newtype instance ToJSON Context
class Monad m => MyMonad (m :: Type -> Type) where
declaration :: Node -> m ()
application :: Node -> Node -> m ()
application :: Node -> m ()
getContext :: m Context
writeContext :: Context -> m ()
@ -131,10 +131,12 @@ instance MyMonad (State Env) where
where
go :: Env -> Env
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 (Set.singleton n) applications }
application n = do
Context c <- getContext
let
go env@Env{applications}
= env { applications = Map.insertWith mappend c (Set.singleton n) applications }
modify go
getContext = gets context
writeContext q = modify go
where
@ -206,8 +208,7 @@ instance References Ruby.Anything where
entries = const $ pure ()
instance References Ruby.Namespace where
entries = \case
Ruby.Namespace xs -> do
entries (Ruby.Namespace xs) = do
Context c <- getContext
let
ctxt = case c of
@ -217,7 +218,7 @@ instance References Ruby.Namespace where
ns = Namespace ((\(Name (Aeson.String t)) -> t) <$> xs)
-- TODO: Broken
-- application c (NodeModule $ ctxt `onTop` ns)
application c (NodeModule $ ns)
application (NodeModule $ ns)
instance References Module where
entries Module{name, block} = do
@ -256,14 +257,9 @@ onTop (Namespace xs) (Namespace ys) = Namespace $ reverse $ reverse xs `onTop'`
instance References Send where
entries Send{namespace, name} = do
Context c <- getContext
let
ctxt = case c of
NodeFunction FQN{namespace = ns} -> ns
NodeModule ns -> ns
-- TODO: Broken
-- application c $ NodeFunction $ qual (ctxt `onTop` fromNS namespace) name
application c $ NodeFunction $ qual (fromNS namespace) name
application $ NodeFunction $ qual (fromNS namespace) name
where
fromNS :: Ruby.Namespace -> Namespace
fromNS (Ruby.Namespace l) = Namespace $ go <$> l