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